1111.frm

visual basic程序实现行星轮设计

    
    For e = 1 To 360 * Val(Combo1.Text)
    
     jj = px(e): ll = py(e): ii = pz(e): kk = pa(e): hh = ps(e): gg = pd(e)
      ex.Range("a" & e + 1).Value = jj
      ex.Range("b" & e + 1).Value = ll
      ex.Range("c" & e + 1).Value = ii
      ex.Range("d" & e + 1).Value = kk
      ex.Range("e" & e + 1).Value = hh
      ex.Range("f" & e + 1).Value = gg
      
      ProgressBar1.Value = e
      
    Next e
    exwbook.SaveAs c
    ex.Quit
    MsgBox "您好！已经保存完毕!", 64, "Excel表保存"
1:
    
End Sub

Private Sub Command5_Click()
End
End Sub


Private Sub Command6_Click()
a1 = 0
r3 = 100 * 24:
If Option1.Value = True Then
k = (Val(C1.Text) / Val(Combo1.Text))
r2 = r3 / k

If Check1.Value = 1 Then
b = -r2 / (k - 1)
Text1.Text = Str(-r2 / (k - 1)) / 24
End If
If Check2.Value = 1 Then
b = Str(Text7.Text) * 24
End If

End If


If Option2.Value = True Then
k = Str(Text8.Text)
r2 = r3 / k
If Check2.Value = 1 Then
b = Str(Text7.Text) * 24
End If

End If

Text2.Text = Str(r2) / 24
a2 = (1 - r3 / r2) * a1
Line1.X1 = 0: Line1.Y1 = 0: Line1.X2 = (r3 - r2) * Cos(pi * a1 / 180): Line1.Y2 = (r3 - r2) * Sin(pi * a1 / 180)
S3.Top = Line1.Y2 + r2: S3.Left = Line1.X2 - r2: S3.Width = 2 * r2: S3.Height = 2 * r2
S4.Left = Line1.X2 - 60: S4.Top = Line1.Y2 + 60: S4.Width = 120: S4.Height = 120
Line2.X1 = Line1.X2: Line2.Y1 = Line1.Y2:
Line2.X2 = (r3 - r2) * Cos(pi * a1 / 180) + b * Cos(pi * (1 - r3 / r2) * a1 / 180)
Line2.Y2 = Line1.Y2 + b * Sin(pi * (1 - r3 / r2) * a1 / 180)
S5.Left = Line2.X2 - 60: S5.Top = Line2.Y2 + 60: S5.Width = 120: S5.Height = 120


L1.Visible = True
L2.Visible = True
Line1.Visible = True
Line2.Visible = True
S1.Visible = True
S2.Visible = True
S3.Visible = True
S4.Visible = True
S5.Visible = True
Label18.Visible = True
Label19.Visible = True


End Sub

Private Sub Command7_Click()
Dim c As String, e As Integer, jj As Double, ll As Double
Timer1.Enabled = False
Dim ex As Object: Dim exwbook As Object: Dim exsheet As Object
Set ex = CreateObject("Excel.Application")
    Set exwbook = Nothing: Set exsheet = Nothing: Set exwbook = ex.Workbooks().Add: Set exsheet = exwbook.Worksheets("sheet1")
    ex.Range("a" & 1).Value = "px "
    ex.Range("b" & 1).Value = "py "

     CommonDialog1.ShowSave: c = CommonDialog1.FileName
      If CommonDialog1.FileName = "" Then GoTo 1
  
    MsgBox CommonDialog1.FileName, 64, "Excel表保存"
    ProgressBar1.Visible = True
     ProgressBar1.Max = 360 * Val(Combo1.Text)
    
    For e = 1 To 360 * Val(Combo1.Text)
    
     jj = pxx(e): ll = pyy(e)
      ex.Range("a" & e + 1).Value = jj
      ex.Range("b" & e + 1).Value = ll
      
      ProgressBar1.Value = e
      
    Next e
    exwbook.SaveAs c
    ex.Quit
    MsgBox "您好！已经保存完毕!", 64, "Excel表保存"
1:

End Sub

Private Sub Command8_Click()
L1.Visible = False
L2.Visible = False
Line1.Visible = False
Line2.Visible = False
S1.Visible = False
S2.Visible = False
S3.Visible = False
S4.Visible = False
S5.Visible = False
Label18.Visible = False
Label19.Visible = False

End Sub

Private Sub Command9_Click()
 Dim filename2 As String
 Dim t As Boolean
   CommonDialog1.FileName = "行星轮上点的轨迹"

   CommonDialog1.Filter = "位图图像(*.bmp)|*.bmp|"

   CommonDialog1.ShowSave

 If CommonDialog1.FileName <> "" Then
    filename2 = CommonDialog1.FileName
 End If
  SavePicture Form1.P1.Image, filename2

End Sub

Private Sub Form_load()

r3 = 100 * 24: k = Val(2.5): r2 = r3 / k
Text2.Text = Str(r2) / 24: Text1.Text = Str(-r2 / (k - 1)) / 24
Const pi! = 3.1415926
P1.Scale (-3000, 3000)-(3000, -3000)
L1.X1 = -2600: L1.Y1 = 0
L1.X2 = 2600: L1.Y2 = 0
L2.X1 = 0: L2.Y1 = -2600
L2.X2 = 0: L2.Y2 = 2600
S1.Left = -2400: S1.Top = 2400: S1.Width = 4800: S1.Height = 4800
S2.Left = -80: S2.Top = 80: S2.Width = 160: S2.Height = 160
r3 = 2400: r2 = 800: k = 3: b = 400
Line1.X1 = 0: Line1.Y1 = 0: Line1.X2 = (r3 - r2) * Cos(pi * 0 / 180): Line1.Y2 = (r3 - r2) * Sin(pi * 0 / 180)
S3.Top = Line1.Y2 + 800: S3.Left = Line1.X2 - 800: S3.Width = 1600: S3.Height = 1600
S4.Left = Line1.X2 - 60: S4.Top = Line1.Y2 + 60: S4.Width = 120: S4.Height = 120
Line2.X1 = Line1.X2: Line2.Y1 = Line1.Y2:
Line2.X2 = (r3 - r2) * Cos(pi * a1 / 180) + b * Cos(pi * (1 - r3 / r2) * a1 / 180)
Line2.Y2 = Line1.Y2 + b * Sin(pi * (1 - r3 / r2) * a1 / 180)
S5.Left = Line2.X2 - 60: S5.Top = Line2.Y2 + 60: S5.Width = 120: S5.Height = 120

End Sub

Private Sub Option1_Click()
If Option1.Value = True Then
Text8.Enabled = False
Check1.Enabled = True

Else
Text8.Enabled = True
End If

End Sub

Private Sub Option2_Click()
If Option2.Value = True Then
Check1.Enabled = False
Check2.Value = 1
a1 = 0

Text8.Enabled = True
k = Str(Text8.Text)
Else
Text8.Enabled = False
Check1.Enabled = True

End If

End Sub

Private Sub Text8_Change()
If Str(Text8.Text) <= 0 Then
MsgBox "k应该取大于0的数"
End If

End Sub

'Private Sub Text7_Change()
'Dim r2!, r3!, k!, a1!, a2!
'r3 = 100 * 24:
'If Option1.Value = True Then
'k = (Val(C1.Text) / Val(Combo1.Text))
'r2 = Abs(-b * (k - 1))
'
'End If
'If Option2.Value = True Then
'k = Str(Text8.Text)
'r2 = r3 / k
'End If
'If Text7.Text = "" Then
'MsgBox "b必须取值"
'Else
'b = Str(Text7.Text) * 24
'
'End If
'
'Text2.Text = Str(r2) / 24
'
'
'a2 = (1 - r3 / r2) * a1
'Line1.X1 = 0: Line1.Y1 = 0: Line1.X2 = (r3 - r2) * Cos(pi * a1 / 180): Line1.Y2 = (r3 - r2) * Sin(pi * a1 / 180)
'S3.Top = Line1.Y2 + r2: S3.Left = Line1.X2 - r2: S3.Width = 2 * r2: S3.Height = 2 * r2
'S4.Left = Line1.X2 - 60: S4.Top = Line1.Y2 + 60: S4.Width = 120: S4.Height = 120
'Line2.X1 = Line1.X2: Line2.Y1 = Line1.Y2:
'Line2.X2 = (r3 - r2) * Cos(pi * a1 / 180) + b * Cos(pi * (1 - r3 / r2) * a1 / 180)
'Line2.Y2 = Line1.Y2 + b * Sin(pi * (1 - r3 / r2) * a1 / 180)
'S5.Left = Line2.X2 - 60: S5.Top = Line2.Y2 + 60: S5.Width = 120: S5.Height = 120
'
'End Sub

'Private Sub Text8_Change()
'Dim r2!, r3!, k!, a1!, a2!
'r3 = 100 * 24:
'If Option1.Value = True Then
'k = (Val(C1.Text) / Val(Combo1.Text))
'End If
'If Option2.Value = True Then
'k = Str(Text8.Text)
'r2 = r3 / k
'End If
'b = Str(Text7.Text) * 24
'
'Text2.Text = Str(r2) / 24
'
'
'a2 = (1 - r3 / r2) * a1
'Line1.X1 = 0: Line1.Y1 = 0: Line1.X2 = (r3 - r2) * Cos(pi * a1 / 180): Line1.Y2 = (r3 - r2) * Sin(pi * a1 / 180)
'S3.Top = Line1.Y2 + r2: S3.Left = Line1.X2 - r2: S3.Width = 2 * r2: S3.Height = 2 * r2
'S4.Left = Line1.X2 - 60: S4.Top = Line1.Y2 + 60: S4.Width = 120: S4.Height = 120
'Line2.X1 = Line1.X2: Line2.Y1 = Line1.Y2:
'Line2.X2 = (r3 - r2) * Cos(pi * a1 / 180) + b * Cos(pi * (1 - r3 / r2) * a1 / 180)
'Line2.Y2 = Line1.Y2 + b * Sin(pi * (1 - r3 / r2) * a1 / 180)
'S5.Left = Line2.X2 - 60: S5.Top = Line2.Y2 + 60: S5.Width = 120: S5.Height = 120
'
'End Sub

Private Sub Timer1_Timer()
 Static m As Integer
Dim xp#, yp#, ppx#, ppy#, ppz#, ppa#, pps#, ppd#
Dim pxxx!, pyyy!
Timer1.Interval = HScroll1.Value
'a1=φ1

a1 = a1 + 1: r3 = 2400

If Option1.Value = True Then
k = (Val(C1.Text) / Val(Combo1.Text))
r2 = r3 / k

If Check1.Value = 1 Then
b = -r2 / (k - 1)
Text1.Text = Str(-r2 / (k - 1)) / 24
End If
If Check2.Value = 1 Then
b = Str(Text7.Text) * 24
End If
End If

If Option2.Value = True Then
k = Str(Text8.Text)
r2 = r3 / k
If Check2.Value = 1 Then
b = Str(Text7.Text) * 24
End If
End If

a2 = (1 - r3 / r2) * a1


Line1.X1 = 0: Line1.Y1 = 0: Line1.X2 = (r3 - r2) * Cos(pi * a1 / 180): Line1.Y2 = (r3 - r2) * Sin(pi * a1 / 180)
S3.Top = Line1.Y2 + r2: S3.Left = Line1.X2 - r2: S3.Width = 2 * r2: S3.Height = 2 * r2
S4.Left = Line1.X2 - 60: S4.Top = Line1.Y2 + 60: S4.Width = 120: S4.Height = 120
Line2.X1 = Line1.X2: Line2.Y1 = Line1.Y2
Line2.X2 = (r3 - r2) * Cos(pi * a1 / 180) + b * Cos(pi * (1 - r3 / r2) * a1 / 180)
Line2.Y2 = Line1.Y2 + b * Sin(pi * (1 - r3 / r2) * a1 / 180)
S5.Left = Line2.X2 - 60: S5.Top = Line2.Y2 + 60: S5.Width = 120: S5.Height = 120
xp = Line2.X2: yp = Line2.Y2

Static xpp(), ypp()
Static m11
m11 = m11 + 1
ReDim Preserve xpp(m11)
ReDim Preserve ypp(m11)
xpp(m11) = xp
ypp(m11) = yp

If m11 >= 2 Then
P1.Line (xpp(m11), ypp(m11))-(xpp(m11 - 1), ypp(m11 - 1)), guijicolor
If a1 = 1 Then P1.Cls
End If

'P1.PSet (xp, yp)
Text3.Text = Str(Line2.X2): Text4.Text = Str(Line2.Y2)
Text5.Text = Str(a1): Text6.Text = Str(a2)

Dim d1x!, d2x!, d3x!, d4x!, d5x!
d1x = -r2 * (k - 1) * Sin(pi * a1 / 180) - b * (1 - k) * Sin((1 - k) * pi * a1 / 180)
d2x = -r2 * (k - 1) * Cos(pi * a1 / 180) - b * (1 - k) ^ 2 * Cos((1 - k) * pi * a1 / 180)
d3x = r2 * (k - 1) * Sin(pi * a1 / 180) + b * (1 - k) ^ 3 * Sin((1 - k) * pi * a1 / 180)
d4x = r2 * (k - 1) * Cos(pi * a1 / 180) + b * (1 - k) ^ 4 * Cos((1 - k) * pi * a1 / 180)
d5x = -r2 * (k - 1) * Sin(pi * a1 / 180) - b * (1 - k) ^ 5 * Sin((1 - k) * pi * a1 / 180)

'Val (Combo1.Text)

'If a1 > 360 * Val(Combo1.Text) Then a1 = a1 - 360 * Val(Combo1.Text)

'Picture1.PSet (Line3.X1 + 10 * a1, Line3.Y1 - xp * 0.8), vbBlue
'Picture1.PSet (Line3.X1 + 10 * a1, Line3.Y1 - D1x * 0.8), vbRed
'Picture1.PSet (Line3.X1 + 10 * a1, Line3.Y1 - D2x * 0.6), vbGreen
'Picture1.PSet (Line3.X1 + 10 * a1, Line3.Y1 - D3x * 0.4)
'Picture1.PSet (Line3.X1 + 10 * a1, Line3.Y1 - D4x * 0.2), RGB(255, 100, 200)
'Picture1.PSet (Line3.X1 + 10 * a1, Line3.Y1 - D5x * 0.1), RGB(255, 100, 10)
Static xp1(), d1x1(), d2x1(), d3x1(), d4x1(), d5x1()
Static m1
m1 = m1 + 1
ReDim Preserve xp1(m1)
ReDim Preserve d1x1(m1)
ReDim Preserve d2x1(m1)
ReDim Preserve d3x1(m1)
ReDim Preserve d4x1(m1)
ReDim Preserve d5x1(m1)

xp1(m1) = xp
d1x1(m1) = d1x

d2x1(m1) = d2x
d3x1(m1) = d3x
d4x1(m1) = d4x
d5x1(m1) = d5x

If m1 >= 2 Then
Picture1.Line (Line3.X1 + 7 * a1 * Log(k) / Log(2.5), Line3.Y1 - xp1(m1) * 0.8)-(Line3.X1 + 7 * (a1 - 1) * Log(k) / Log(2.5), Line3.Y1 - xp1(m1 - 1) * 0.8), vbBlue
Picture1.Line (Line3.X1 + 7 * a1 * Log(k) / Log(2.5), Line3.Y1 - d1x1(m1) * 0.8 * (2.5 / k))-(Line3.X1 + 7 * (a1 - 1) * Log(k) / Log(2.5), Line3.Y1 - d1x1(m1 - 1) * 0.8 * (2.5 / k)), vbRed
Picture1.Line (Line3.X1 + 7 * a1 * Log(k) / Log(2.5), Line3.Y1 - d2x1(m1) * 0.5 * (2.5 / k) ^ 2)-(Line3.X1 + 7 * (a1 - 1) * Log(k) / Log(2.5), Line3.Y1 - d2x1(m1 - 1) * 0.5 * (2.5 / k) ^ 2), vbGreen
Picture1.Line (Line3.X1 + 7 * a1 * Log(k) / Log(2.5), Line3.Y1 - d3x1(m1) * 0.5 * (2.5 / k) ^ 3)-(Line3.X1 + 7 * (a1 - 1) * Log(k) / Log(2.5), Line3.Y1 - d3x1(m1 - 1) * 0.5 * (2.5 / k) ^ 3)
Picture1.Line (Line3.X1 + 7 * a1 * Log(k) / Log(2.5), Line3.Y1 - d4x1(m1) * 0.4 * (2.5 / k) ^ 4)-(Line3.X1 + 7 * (a1 - 1) * Log(k) / Log(2.5), Line3.Y1 - d4x1(m1 - 1) * 0.4 * (2.5 / k) ^ 4), RGB(255, 100, 200)
Picture1.Line (Line3.X1 + 7 * a1 * Log(k) / Log(2.5), Line3.Y1 - d5x1(m1) * 0.2 * (2.5 / k) ^ 5)-(Line3.X1 + 7 * (a1 - 1) * Log(k) / Log(2.5), Line3.Y1 - d5x1(m1 - 1) * 0.2 * (2.5 / k) ^ 5), RGB(255, 100, 10)
Picture1.Line (Line3.X1 + 7 * a1 * Log(k) / Log(2.5), Line3.Y1 - 0)-(Line3.X1 + 7 * (a1 - 1) * Log(k) / Log(2.5), Line3.Y1 - 0), vbYellow

End If



pxx(m1) = Line2.X2
pyy(m1) = Line2.Y2

px(m) = xp * 0.8: py(m) = d1x * 0.8: pz(m) = d2x * 0.6: pa(m) = d3x * 0.4: ps(m) = d4x * 0.2: pd(m) = d5x * 0.1
m = m + 1

'Text9.Text = Val(Format("#####.###", (a1 / 360)))
Text9.Text = Format((a1 / 360), "#####.###")

End Sub