这个可否用?
程序代码: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