01-09-2026, 06:36 PM
(This post was last modified: 01-09-2026, 06:38 PM by ahenry3068.)
MYSTIFY Clone with a little customizable twist:
Also using a _MEM pointer so that I can have an array attached to a User Defined type
Also using a _MEM pointer so that I can have an array attached to a User Defined type
Code: (Select All)
Option _Explicit
Type PointType
X As Long
Y As Long
XInc As Integer
YInc As Integer
End Type
Dim Shared Pt As PointType
Type BOXTYPE
POINTS As _MEM
NUMPOINTS As Integer
bCOLOR As _Unsigned Long
End Type
Dim Shared X_ColorChange As Integer
Dim Shared Y_ColorChange As Integer
Dim Shared XLimit As Long
Dim Shared YLimit As Long
Dim Shared NumPoints As Long
Dim Shared NumBoxes As Long
Dim Shared NumLines As Long
Dim FrameSpeed As Long
Dim Shared TrailPointer As Long
Dim Shared CurTrail As Long
Dim Shared DrawPointer As Long
Dim I As Long
Dim J As Long
Randomize Timer
Width 60, 50
_Title "SET UP MYSTIFY"
GoSub SPEEDMESSAGE
Dim x$
Locate 3, 2
Print "USE DEFAULT VALUES --> : ";
Line Input x$
x$ = _Trim$(UCase$(x$))
If x$ = "" Then
Print
Print "ERROR"
GoTo GETYBOUNCE
End If
If (Left$(x$, 1) = "Y") Then
NumBoxes = 2
NumPoints = 4
NumLines = 30
X_ColorChange = _TRUE
Y_ColorChange = _FALSE
FrameSpeed = 60
GoTo start_me_up
End If
Cls
FrameSpeed = 60
GETNUMBOX:
GoSub SPEEDMESSAGE
Locate 2, 2
Print "NUMBER OF BOXES (1 to 10) --> : ";
Line Input x$
If Val(x$) < 1 Or Val(x$) > 10 Then
Print
Print "ERROR -->"; x$; " Is not Valid !"
GoTo GETNUMBOX
End If
NumBoxes = Val(x$)
Cls
GETNUMCORNERS:
GoSub SPEEDMESSAGE
Locate 3, 2
Print "NUMBER OF BOX CORNERS (3 to 10) --> : ";
Line Input x$
If Val(x$) < 3 Or Val(x$) > 10 Then
Print
Print "ERROR -->"; x$; " Is not Valid !"
GoTo GETNUMCORNERS
End If
NumPoints = Val(x$)
Cls
gettraillines:
GoSub SPEEDMESSAGE
Locate 2, 2
Print "NUMBER OF TRAILING BOXES (8 to 100) --> : ";
Line Input x$
If Val(x$) < 8 Or Val(x$) > 100 Then
Print
Print "ERROR -->"; x$; " Is not Valid !"
GoTo gettraillines
End If
NumLines = Val(x$)
Cls
GETXBOUNCE:
GoSub SPEEDMESSAGE
Locate 3, 2
Print "Change Color on X Bounce (Y/N) --> : ";
Line Input x$
x$ = _Trim$(UCase$(x$))
If x$ = "" Then
Print
Print "ERROR"
GoTo GETXBOUNCE
End If
X_ColorChange = (Left$(x$, 1) = "Y")
Cls
GETYBOUNCE:
GoSub SPEEDMESSAGE
Locate 3, 2
Print "Change Color on Y Bounce (Y/N) --> : ";
Line Input x$
x$ = _Trim$(UCase$(x$))
If x$ = "" Then
Print
Print "ERROR"
GoTo GETYBOUNCE
End If
Y_ColorChange = (Left$(x$, 1) = "Y")
start_me_up:
TrailPointer = 0
XLimit = 1152
YLimit = 864
Dim Shared DRAW_TRAIL As Integer
DRAW_TRAIL = _FALSE
ReDim BOXS(0 To NumBoxes - 1) As BOXTYPE
ReDim TrailBoxes(NumBoxes, NumLines) As BOXTYPE
For I = 0 To NumBoxes - 1
INIT_BOX BOXS(I)
For J = 0 To NumLines - 1
INIT_BOX TrailBoxes(I, J)
TrailBoxes(I, J).bCOLOR = _RGB32(0, 0, 0, 255)
Next
Next
Screen _NewImage(XLimit, YLimit, 32)
Line (0, 0)-(XLimit - 2, YLimit - 1), _RGB32(0, 0, 0, 255), BF
_FullScreen , _Smooth
Dim C As Long
DrawPointer = 0
CurTrail = 0
TrailPointer = 0
DRAW_TRAIL = _FALSE
Do
For I = 0 To NumBoxes - 1
If DRAW_TRAIL Then DrawBox TrailBoxes(I, CurTrail)
DrawBox BOXS(I)
CopyBox BOXS(I), TrailBoxes(I, TrailPointer)
MoveBox BOXS(I)
Next
If DRAW_TRAIL Then
CurTrail = CurTrail + 1
If CurTrail = NumLines Then CurTrail = 0
End If
TrailPointer = TrailPointer + 1
If TrailPointer = NumLines Then
DRAW_TRAIL = _TRUE
TrailPointer = 0
End If
C = _KeyHit
If C = _KEY_UP Then
If FrameSpeed < 200 Then FrameSpeed = FrameSpeed + 1
End If
If C = _KEY_DOWN Then
If FrameSpeed > 20 Then FrameSpeed = FrameSpeed - 1
End If
_Limit FrameSpeed
Loop Until C = 27
System
SPEEDMESSAGE:
Locate 20, 10
Color 10
Print "ARROW KEYS WILL CONTROL ANIMATION SPEED."
Color 15
Return
Sub CopyBox (Box1 As BOXTYPE, Box2 As BOXTYPE)
Dim DPoints(0 To NumPoints - 1) As PointType
_MemGet Box1.POINTS, Box1.POINTS.OFFSET, DPoints()
_MemPut Box2.POINTS, Box2.POINTS.OFFSET, DPoints()
End Sub
Function RandomColor&&
Static R As Integer
Static G As Integer
Static B As Integer
Static Total As Integer
GETCOLORS:
R = Int(Rnd * 255) + 1
G = Int(Rnd * 255) + 1
B = Int(Rnd * 255) + 1
Total = R + G + B
If Total < 100 GoTo GETCOLORS
RandomColor = _RGB32(R, G, B, 255)
End Function
Sub INIT_BOX (BOX As BOXTYPE)
Dim DPoints(0 To NumPoints - 1) As PointType
Dim I As Long
Dim R As Integer
Dim G As Integer
Dim B As Integer
BOX.POINTS = _MemNew(Len(Pt) * NumPoints)
For I = 0 To NumPoints - 1
DPoints(I).X = Int(Rnd * XLimit)
DPoints(I).Y = Int(Rnd * YLimit)
DPoints(I).XInc = Int(Rnd * 5) + 1
DPoints(I).YInc = Int(Rnd * 5) + 1
If Int(Rnd * 11) < 5 Then
DPoints(I).XInc = DPoints(I).XInc * -1
End If
If Int(Rnd * 11) < 5 Then
DPoints(I).YInc = DPoints(I).YInc * -1
End If
Next
_MemPut BOX.POINTS, BOX.POINTS.OFFSET, DPoints()
BOX.bCOLOR = RandomColor
End Sub
Sub DrawBox (Box As BOXTYPE)
Dim I As Long
Dim X As Long
Dim Y As Long
Dim X2 As Long
Dim Y2 As Long
Dim DestIndx As Long
Dim Dest As Long
Dim DPoints(0 To NumPoints - 1) As PointType
_MemGet Box.POINTS, Box.POINTS.OFFSET, DPoints()
Dest = NumPoints - 1
For I = 0 To Dest
If I = Dest Then DestIndx = 0 Else DestIndx = I + 1
X = DPoints(I).X
Y = DPoints(I).Y
X2 = DPoints(DestIndx).X
Y2 = DPoints(DestIndx).Y
Line (X, Y)-(X2, Y2), Box.bCOLOR
Next
End Sub
Sub MoveBox (Box As BOXTYPE)
Dim I As Long
Dim X As Long
Dim Y As Long
Dim X2 As Long
Dim Y2 As Long
Dim DestIndx As Long
Dim Dest As Long
Dim DPoints(0 To NumPoints - 1) As PointType
_MemGet Box.POINTS, Box.POINTS.OFFSET, DPoints()
Dest = NumPoints - 1
For I = 0 To Dest
DPoints(I).X = DPoints(I).X + DPoints(I).XInc
DPoints(I).Y = DPoints(I).Y + DPoints(I).YInc
If DPoints(I).X >= XLimit Then
DPoints(I).X = XLimit
DPoints(I).XInc = (Int(Rnd * 5) + 1) * -1
If X_ColorChange Then
Box.bCOLOR = RandomColor
End If
End If
If DPoints(I).X <= 0 Then
DPoints(I).X = 0
DPoints(I).XInc = (Int(Rnd * 5) + 1)
End If
If DPoints(I).Y >= YLimit Then
DPoints(I).Y = YLimit
DPoints(I).YInc = (Int(Rnd * 5) + 1) * -1
If Y_ColorChange Then
Box.bCOLOR = RandomColor
End If
End If
If DPoints(I).Y <= 0 Then
DPoints(I).Y = 0
DPoints(I).YInc = (Int(Rnd * 5) + 1)
End If
Next
_MemPut Box.POINTS, Box.POINTS.OFFSET, DPoints()
End Sub