Fixup 2 Gears
#7
Thumbs Up 
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
Reply


Messages In This Thread
Fixup 2 Gears - by bplus - 02-25-2023, 06:34 PM
RE: Fixup 2 Gears - by aurel - 02-25-2023, 07:49 PM
RE: Fixup 2 Gears - by bplus - 02-25-2023, 08:46 PM
RE: Fixup 2 Gears - by PhilOfPerth - 02-25-2023, 10:53 PM
RE: Fixup 2 Gears - by bplus - 02-25-2023, 11:23 PM
RE: Fixup 2 Gears - by PhilOfPerth - 02-26-2023, 01:21 AM
RE: Fixup 2 Gears - by Kernelpanic - 02-27-2023, 02:55 PM
RE: Fixup 2 Gears - by vince - 03-03-2023, 01:50 PM



Users browsing this thread: 5 Guest(s)