I've never made something like this before so I figured I would try it out using the fillcircle sub as pitch black and a colored circle around each of the 2 circles. It might be useful on something someday. I should point out that the 3D rotation orbit isn't a circle, it's more like a 3D square. I couldn't figure out the equation for a 3D orbit on the Z axis, so I just winged it.
Edit: There's a full-circle 3D one on a post below on this thread that I figured out. But I am keeping this one in case anyone wants to use this type.
Edit: There's a full-circle 3D one on a post below on this thread that I figured out. But I am keeping this one in case anyone wants to use this type.
Code: (Select All)
Screen _NewImage(800, 600, 32)
Dim c As Long, c2 As Long
cx = 600: cy = 300: r = 98: c = _RGB32(0, 0, 0)
dir = 1
cx2 = 200: cy2 = 300: r2 = 98: c2 = _RGB32(0, 0, 0)
dir2 = 2
r = 100
r2 = 100
firstoverlap:
Do
a$ = InKey$
If a$ = Chr$(27) Then End
If dir = 1 And dir2 = 2 Then GoTo secondoverlap:
For t = 0 To 360
x = (Sin(t) * (r + 2)) + cx
y = (Cos(t) * (r + 2)) + cy
Circle (x, y), 2, _RGB32(0, 255, 0)
fillCircle cx, cy, r, c
Next t
If dir = 1 And cx < 400 Then r = r - 1
If dir = 1 And cx > 399 Then r = r + 1
If dir = 2 And cx < 400 Then r = r + 1
If dir = 2 And cx > 399 Then r = r - 1
If r < 50 Then r = 50
If r > 150 Then r = 150
If dir = 1 Then cx = cx + 10
If dir = 2 Then cx = cx - 10
If cx > 600 Then dir = 2
If cx < 200 Then dir = 1
For t = 0 To 360
x = (Sin(t) * (r2 + 2)) + cx2
y = (Cos(t) * (r2 + 2)) + cy2
Circle (x, y), 2, _RGB32(255, 0, 0)
fillCircle cx2, cy2, r2, c2
Next t
If dir2 = 1 And cx2 < 400 Then r2 = r2 + 1
If dir2 = 1 And cx2 > 399 Then r2 = r2 - 1
If dir2 = 2 And cx2 < 400 Then r2 = r2 - 1
If dir2 = 2 And cx2 > 399 Then r2 = r2 + 1
If r2 < 50 Then r2 = 50
If r2 > 150 Then r2 = 150
If dir2 = 1 Then cx2 = cx2 + 10
If dir2 = 2 Then cx2 = cx2 - 10
If cx2 > 600 Then dir2 = 2
If cx2 < 200 Then dir2 = 1
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 50), BF
_Display
Loop
secondoverlap:
Do
a$ = InKey$
If a$ = Chr$(27) Then End
If dir = 2 And dir2 = 1 Then GoTo firstoverlap:
For t = 0 To 360
x = (Sin(t) * (r2 + 2)) + cx2
y = (Cos(t) * (r2 + 2)) + cy2
Circle (x, y), 2, _RGB32(255, 0, 0)
fillCircle cx2, cy2, r2, c2
Next t
If dir2 = 1 And cx2 < 400 Then r2 = r2 - 1
If dir2 = 1 And cx2 > 399 Then r2 = r2 + 1
If dir2 = 2 And cx2 < 400 Then r2 = r2 + 1
If dir2 = 2 And cx2 > 399 Then r2 = r2 - 1
If r2 < 50 Then r2 = 50
If r2 > 150 Then r2 = 150
If dir2 = 1 Then cx2 = cx2 + 10
If dir2 = 2 Then cx2 = cx2 - 10
If cx2 > 600 Then dir2 = 2
If cx2 < 200 Then dir2 = 1
For t = 0 To 360
x = (Sin(t) * (r + 2)) + cx
y = (Cos(t) * (r + 2)) + cy
Circle (x, y), 2, _RGB32(0, 255, 0)
fillCircle cx, cy, r, c
Next t
If dir = 1 And cx < 400 Then r = r + 1
If dir = 1 And cx > 399 Then r = r - 1
If dir = 2 And cx < 400 Then r = r - 1
If dir = 2 And cx > 399 Then r = r + 1
If r < 50 Then r = 50
If r > 150 Then r = 150
If dir = 1 Then cx = cx + 10
If dir = 2 Then cx = cx - 10
If cx > 600 Then dir = 2
If cx < 200 Then dir = 1
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 50), BF
_Display
Loop
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub