Public r, d, rp, dd, pin, crankpin, n, t1, m, k, stepe1, stepe, pi, w, c, mou

Private Sub Form_Activate()

Dim angle(35, 4)

ForeColor = &H0&
pi = 4 * Atn(1)
n = 11
r = 50
d0 = 200
d = d0
rp = 52.5
stepe1 = 0.05
stepe = stepe1
SH = Form1.ScaleHeight
SW = Form1.ScaleWidth
ST = Form1.ScaleTop
SL = Form1.ScaleLeft

n1 = n: d1 = d: rp1 = rp


Do

For i = 1 To 35: For j = 0 To 4: angle(i, j) = 0: Next j: Next i

Do

dd = d - rp
pin = 10
crankpin = 27

For i = 2 To n
fi = (i - 1) * 2 * pi / n
X = rp * Sin(fi)
Y = rp * Cos(fi)
fii = Atn(X / Sqr(d ^ 2 - X ^ 2))
angle(i, 0) = fi + fii
Next i

DoEvents

If n <> n1 Or d1 <> d Or rp1 <> rp Then
    If d1 <> d Then
        a = (r + d) / (r + d0)
        Form1.ScaleHeight = SH * a
        Form1.ScaleWidth = SW * a
        Form1.ScaleLeft = SL * a
        Form1.ScaleTop = ST * a
    End If
n1 = n: d1 = d: rp1 = rp
Cls
End If

Label1 = "  ": Label1 = n
Label2 = "  ": Label2 = Int(50 * d / r) / 100
Label3 = "  ": Label3 = Int(100 * rp / r) / 100

Do While w = 1: DoEvents: Loop

j = j + stepe

If j > 2 * pi Then j = j - 2 * pi

DrawWidth = 1
For k = 1 To n
Line ((d - r) * Sin((k - 1) * 2 * pi / n), (d - r) * Cos((k - 1) * 2 * pi / n))-((d + r) * Sin((k - 1) * 2 * pi / n), (d + r) * Cos((k - 1) * 2 * pi / n)), &H808080
Next k
ForeColor = &H808080
Line (-10, 0)-(10, 0)
Line (0, -10)-(0, 10)
Circle (0, 0), r
DrawWidth = 3

X = r * Sin(j): Y = r * Cos(j)
ff = Atn(X / Sqr(d ^ 2 - X ^ 2))
yy = Y + Sqr(d ^ 2 - X ^ 2)

ForeColor = BackColor
Line (angle(1, 1), angle(1, 2))-(0, angle(1, 4))
Circle (0, angle(1, 4)), pin
Circle (angle(1, 1), angle(1, 2)), crankpin

angle(1, 3) = 0: angle(1, 4) = yy
angle(1, 1) = X: angle(1, 2) = Y

ForeColor = &HFF0000
Line (angle(1, 1), angle(1, 2))-(0, angle(1, 4))
Circle (0, angle(1, 4)), pin
Circle (angle(1, 1), angle(1, 2)), crankpin


For i = 2 To n
X1 = X + rp * Sin(angle(i, 0) - ff)
Y1 = Y + rp * Cos(angle(i, 0) - ff)
xy = Sqr(X1 ^ 2 + Y1 ^ 2)
ii = (i - 1) * 2 * pi / n

l1 = d + 2 * r
l2 = r / 2
lll = 0

Do

    qq = 0.5 * (l1 + l2)
  
    xq = qq * Sin(ii): yq = qq * Cos(ii)
    
    qd = Sqr((xq - X1) ^ 2 + (yq - Y1) ^ 2)
    
    If qd > dd Then l1 = qq Else l2 = qq
    
    lll = lll + 1
    
    If Abs(qd - dd) < 0.1 Or lll > 100 Then Exit Do
    
Loop

If lll > 300 Then Cls

m = 1

ll = qq

ForeColor = BackColor
Circle (angle(i, 1), angle(i, 2)), pin
Circle (angle(i, 3), angle(i, 4)), pin
Line (angle(i, 1), angle(i, 2))-(angle(i, 3), angle(i, 4))
ForeColor = &HFF0000
angle(i, 1) = X1: angle(i, 2) = Y1: angle(i, 3) = ll * Sin(ii): angle(i, 4) = ll * Cos(ii)
Circle (angle(i, 1), angle(i, 2)), pin
Circle (angle(i, 3), angle(i, 4)), pin
ForeColor = &HFF&
Line (angle(i, 1), angle(i, 2))-(angle(i, 3), angle(i, 4))

Next i

If c = 1 Then
    xxx1 = xxx: xxx = 0
    yyy1 = yyy: yyy = 0
    aa = 0.87 * 11 / n
    For i = 1 To n: xxx = xxx + angle(i, 3): yyy = yyy + angle(i, 4): Next i
    DrawWidth = 1
    ForeColor = BackColor
    Line (0, 0)-(aa * xxx1, aa * yyy1)
    ForeColor = &H40C0&
    Line (0, 0)-(aa * xxx, aa * yyy)
    DrawWidth = 3
    DoEvents
End If

If n <> n1 Or d1 <> d Or rp1 <> rp Then
    If d1 <> d Then
        a = (r + d) / (r + d0)
        Form1.ScaleHeight = SH * a
        Form1.ScaleWidth = SW * a
        Form1.ScaleLeft = SL * a
        Form1.ScaleTop = ST * a
    End If
n1 = n: d1 = d: rp1 = rp
Cls
End If

Loop

Loop

End

End Sub


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    mou = (mou + 1) Mod 2
End Sub

Private Sub Form_DblClick()
    Cls
    End
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Cls: End
    If Chr(KeyAscii) = "." Then stepe = stepe * 1.05
    If Chr(KeyAscii) = "," Then stepe = stepe * 0.95
    If Chr(KeyAscii) = "/" Then stepe = stepe1
    If Chr(KeyAscii) = "c" Or Chr(KeyAscii) = "C" Then c = (c + 1) Mod 2
    If Chr(KeyAscii) = " " Then w = (w + 1) Mod 2
End Sub

Private Sub VScroll1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Cls: End
    If Chr(KeyAscii) = "." Then stepe = stepe * 1.05
    If Chr(KeyAscii) = "," Then stepe = stepe * 0.95
    If Chr(KeyAscii) = "/" Then stepe = stepe1
    If Chr(KeyAscii) = "c" Or Chr(KeyAscii) = "C" Then c = (c + 1) Mod 2
    If Chr(KeyAscii) = " " Then w = (w + 1) Mod 2
End Sub
Private Sub VScroll2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Cls: End
    If Chr(KeyAscii) = "." Then stepe = stepe * 1.05
    If Chr(KeyAscii) = "," Then stepe = stepe * 0.95
    If Chr(KeyAscii) = "/" Then stepe = stepe1
    If Chr(KeyAscii) = "c" Or Chr(KeyAscii) = "C" Then c = (c + 1) Mod 2
    If Chr(KeyAscii) = " " Then w = (w + 1) Mod 2
End Sub
Private Sub VScroll3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Cls: End
    If Chr(KeyAscii) = "." Then stepe = stepe * 1.05
    If Chr(KeyAscii) = "," Then stepe = stepe * 0.95
    If Chr(KeyAscii) = "/" Then stepe = stepe1
    If Chr(KeyAscii) = "c" Or Chr(KeyAscii) = "C" Then c = (c + 1) Mod 2
    If Chr(KeyAscii) = " " Then w = (w + 1) Mod 2
End Sub

Private Sub VScroll1_Change()
    n = 36 - VScroll1
End Sub

Private Sub VScroll2_Change()
    d = r * (900 - VScroll2) / 100
End Sub

Private Sub VScroll3_Change()
    rp = r * (200 - VScroll3) / 100
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If mou = 1 And X * Y <> 0 Then stepe = X * Y / 200000
End Sub