02-27-2023, 02:55 PM
Very good! Especially the spinning wheels. I should really look into graphics under QB64. - I put that together.
Code: (Select All)
'Zahnraeder, bplus - 25. Feb. 2023
Screen 12
For N = 0 To 15
Palette N, N * 263172
Next N
For Z = 0 To 100 Step .25
For A = 0 To 6.2831853 Step .001
R = 100 + Cos(20 * A + Z / 20) * 15
X1 = Cos(A) * R + 220: Y1 = Sin(A) * R / 3 + 240 - Z / 2
R = 50 + Sin(-10 * A + Z / 20) * 15
X2 = Cos(A) * R + 370: Y2 = Sin(A) * R / 3 + 240 - Z / 2
PSet (X1, Y1), Z * .125 + 2.5
PSet (X2, Y2), Z * .125 + 2.5
If Z = 100 Then
Line (220, 240 - Z / 2)-(X1, Y1), 8
Line (370, 240 - Z / 2)-(X2, Y2), 5
End If
Next A
Next Z
Locate CsrLin + 2, 2
Print "Press ESC to continue!"
Do
'Bild stehen lassen bis Escape gedrueckt wurde.
Loop Until InKey$ = Chr$(27)
'Drehende Zahnraeder
_Title "Fixed 2 Turning Gears mod B+ 2023-02-25"
Screen 12
For N = 0 To 15
Palette N, N * 263172
Next N
Do
Cls
For Z = 0 To 20 Step .5
For A = 0 To 6.2831853 Step .001
R = 100 + Cos(20 * A) * 15: X1 = Cos(A + ao) * R + 220
Y1 = Sin(A + ao) * R / 3 + 240 - Z / 2
R = 50 + Sin(-10 * A) * 15: X2 = Cos(A - 2 * ao) * R + 390
Y2 = Sin(A - 2 * ao) * R / 3 + 240 - Z / 2
PSet (X1, Y1), Z * .125 + 2.5
PSet (X2, Y2), Z * .125 + 2.5
If Z = 20 Then
Line (220, 240 - Z / 2)-(X1, Y1), 8
Line (370, 240 - Z / 2)-(X2, Y2), 5
End If
Next A
Next Z
_Display
_Limit 200
ao = ao + .04
Loop Until InKey$ = Chr$(27)
_Title "Fixed 2 Turning Gears mod B+ 2023-02-25"
'https://staging.qb64phoenix.com/showthread.php?tid=1503&pid=13854#pid13854
Screen _NewImage(640, 480, 32)
Do
Cls
For Z = 0 To 40
For A = 0 To 6.2831853 Step .0006
R = 100 + Cos(20 * A) * 15
X1 = Cos(A + ao) * R + 220
Y1 = Sin(A + ao) * R / 3 + 240 - Z / 2
R = 50 + Sin(-10 * A) * 15
X2 = Cos(A - 2 * ao) * R + 390
Y2 = Sin(A - 2 * ao) * R / 3 + 240 - Z / 2
PSet (X1, Y1), _RGB32(Z / 40 * 200)
PSet (X2, Y2), _RGB32(Z / 40 * 160)
If Z = 40 Then
Line (220, 240 - Z / 2)-(X1, Y1), _RGB32(200)
Line (390, 240 - Z / 2)-(X2, Y2), _RGB32(160)
End If
Next A
Next Z
_Display
_Limit 200
ao = ao + .04
Loop Until InKey$ = Chr$(27)
End