这个可否用?
工程1.zip
(5.3 KB)
Dim Coner As Single, cTurn As Integer Private Sub Command1_Click() If Command1.Caption = "转动" Then Timer1.Interval = 100 Command1.Caption = "停止" Else Timer1.Interval = 0 Command1.Caption = "转动" End If End Sub Private Sub Command2_Click() If cTurn = 1 Then cTurn = -1 Command2.Caption = "顺时针" Else cTurn = 1 Command2.Caption = "逆时针" End If End Sub Private Sub Command3_Click() Text1 = Val(Text1) - 1 If Val(Text1) < 1 Then Text1 = 1 End Sub Private Sub Command4_Click() Text1 = Val(Text1) + 1 End Sub Private Sub Form_Load() Me.ScaleMode = 3 '设置为像素 Coner = 0 '转角为0 cTurn = 1 '旋转方向为顺时针 Text1 = 10 '旋转速度为10 Timer1.Interval = 0 '定时器暂停 Timer1_Timer '根据初始值画图 End Sub Private Sub Timer1_Timer() Dim ox As Integer, oy As Integer, r As Integer, l As Integer Dim x As Single, y As Single, lx As Single, ly As Single Dim i As Integer, Devia As Single, oldDev As Single If Timer1.Interval > 0 Then Coner = Coner + Val(Text1) * cTurn If cTurn > 0 And Coner > 360 Then Coner = Coner - 360 If cTurn < 0 And Coner < 0 Then Coner = Coner + 360 End If Me.Cls r = 0.1 * Me.ScaleWidth '根据窗体宽度计算半径 l = 3 * r '连杆长度为半径3倍(必须大于2倍半径) oy = Me.ScaleHeight * 0.5 ox = Me.ScaleWidth - r - 10 Shape1.Top = oy - Shape1.Height * 0.5 Shape1.Left = ox - Shape1.Width * 0.5 '计算圆心位置ox、oy并定位显示圆心 x = ox - r * Cos(Coner * 3.1415926 / 180) y = oy - r * Sin(Coner * 3.1415926 / 180) '根据半径和转角计算圆上点坐标x、y ly = oy '活塞和圆心同轴(在x轴运动,y轴相同) oldDev = l '给一个最大的误差值,以精确计算活塞在x轴上的运动位置 For i = ox - 4 * r To ox - r Devia = Abs(l - Sqr((x - i) ^ 2 + (y - oy) ^ 2)) If Devia > oldDev Then Exit For '误差应该越来越小,如果变大说明上一次i值就是正确的x坐标值 oldDev = Devia Next '上述循环是用笨办法计算误差变化取得活塞运动坐标,其实可以解一元二次方程取一个有意义的根作为x坐标值 lx = i - 1 Label1.Left = lx - Label1.Width Label1.Top = ly - Label1.Height * 0.5 '显示活塞 Me.Line (ox, oy)-(x, y), vbBlue '显示曲轴 Me.Line (x, y)-(lx, ly), vbRed '显示连杆 End Sub