'新建窗体，添加 command1,label1,hscroll1,timer1,picture1 Const pi = 3.1415926 Dim angle As Integer Private Sub Form_Load() '调整空间尺寸，位置及初始参数 Me.ScaleMode = 3 Me.Caption = "曲柄滑块机构的演示" Me.Width = 5000 Me.Height = 3500 Picture1.ScaleMode = 3 Picture1.AutoRedraw = True Picture1.Move 0, 0, Me.ScaleWidth, 150 Command1.Caption = "开始(&B)" Command1.Move 20, 160, 70, 30 Label1.Caption = "速度：" Label1.Move 120, 170, 100, 30 HScroll1.Min = 1 HScroll1.Max = 20 HScroll1.Move 160, 160, 140, 30 Timer1.Interval = 20 Timer1.Enabled = False End Sub Private Sub Command1_Click() Timer1.Enabled = Not Timer1.Enabled If Timer1.Enabled Then Command1.Caption = "暂停(&S)" Else Command1.Caption = "开始(&B)" End If End Sub Sub draw(ByVal ox As Integer, ByVal oy As Integer, ByVal orad As Integer) 'ox,oy 圆心坐标,orad 半径 angle = (angle + HScroll1.Value) Mod 360 xo = ox + orad * Cos(angle * pi / 180) '圆周上的铰链点坐标(xo,yo) yo = oy + orad * Sin(angle * pi / 180) xs = Sqr((4 * orad) ^ 2 - 10 ^ 2) + xo '滑块的左边界 x 坐标，连杆长度取 4*orad,滑块高度取 20(像素) Picture1.BackColor = Picture1.BackColor Picture1.DrawStyle = 0 '实线 Picture1.DrawWidth = 2 '线宽 2 Picture1.Line (ox + 2 * orad, oy)-(ox + 6 * orad, oy) '壁面 Picture1.Line (ox, oy)-(xo, yo) '连接圆心与圆周上的铰链点 Picture1.Line (xs, oy - 10)-(xo, yo), vbBlue '连接滑块与圆周上的铰链点 

Picture1.FillStyle = 1 '透明填充 Picture1.Circle (ox, oy), orad '画圆 Picture1.FillStyle = 0 '实体填充 Picture1.FillColor = vbWhite '圆心 Picture1.Circle (ox, oy), 5 Picture1.FillColor = vbGreen '圆周上的铰链点 Picture1.Circle (xo, yo), 4 Picture1.FillColor = vbRed '滑块 Picture1.Line (xs, oy - 20)-(xs + 30, oy), , B Picture1.DrawStyle = 2 '虚线 Picture1.DrawWidth = 1 '线宽 1 For i = 0 To 9 '表示壁面的虚线 Picture1.Line (i * 4 * orad / 10 + ox + 2 * orad, oy)-(i * 4 * orad / 10 + ox + 2 * orad + 20, oy + 20) Next End Sub Private Sub Timer1_Timer() '画 draw 60, 60, 40 End Sub