VERSION 2.00
Begin Form ManyThings
BackColor = &H00000000&
BorderStyle = 0 'None
ClientHeight = 4605
ClientLeft = 1845
ClientTop = 1710
ClientWidth = 7995
ControlBox = 0 'False
Height = 5010
Icon = MANYTHNG.FRX:0000
Left = 1785
LinkTopic = "Form1"
ScaleHeight = 307
ScaleMode = 3 'Pixel
ScaleWidth = 533
Top = 1365
Width = 8115
Begin Timer Tick
Enabled = 0 'False
Interval = 50
Left = 10
Top = 10
End
Begin Label PasswordLabel
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = "Need Password "
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Times New Roman"
FontSize = 24.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 690
Left = 2430
TabIndex = 0
Top = 3510
Visible = 0 'False
Width = 4470
End
End
' BackGround -- this form expands to fill the whole
' screen and is used as the back drop for all the
' drawing
Option Explicit
' variables declared here
Dim MouseX, MouseY ' Last position of the mouse moves
Dim LastX As Integer, LastY As Integer
'Dim conv2x As Single, conv2y As Single
Dim LastTime As Long
Dim CurrentTime As Long
Dim LinkTime As Long
Dim PlotType As Integer
Dim PlotInit As Integer
Dim PlotEnd As Integer
Dim RepeatIndex As Integer
Dim Pointer As Integer
Dim Mirror As Integer
Dim RunMode As Integer
Dim x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer
Dim vx1 As Single, vy1 As Single, vx2 As Single, vy2 As Single
Dim ax1 As Single, ax2 As Single, ay1 As Single, ay2 As Single
Dim l As Long
Dim m As Long
Dim MaxSpeedX As Integer, MaxSpeedY As Integer
Dim TimeInterval As Long
Dim MaxTime As Long
Dim Repeats As Integer
Dim i As Integer
Dim BoxHeight As Integer, BoxWidth As Integer
Dim DC As Integer
Dim Pattern As Long, Locked As Integer
Dim Direction As Integer
Dim Number As Integer
Dim PicWidth As Integer, PicHeight As Integer
Dim PriorityBreakPoints() As Single
Dim Priorities() As Integer
Dim TotalPriority As Single
Dim MaxPlotType As Integer
' values for GetBrightNonGray:
' minimum magnitude squared of colors
Const MinColor = 3000' was 10000
' minimum difference between colors
Const MinDiff = 30
'Allocate Memory
Dim x1a() As Integer
Dim x2a() As Integer
Dim y1a() As Integer
Dim y2a() As Integer
Dim x1da() As Integer
Dim x2da() As Integer
Dim y1da() As Integer
Dim y2da() As Integer
Dim x1sa() As Single
Dim x2sa() As Single
Dim y1sa() As Single
Dim y2sa() As Single
Dim vx1sa() As Single
Dim vx2sa() As Single
Dim vy1sa() As Single
Dim vy2sa() As Single
Dim ax1sa() As Single
Dim ax2sa() As Single
Dim ay1sa() As Single
Dim ay2sa() As Single
Dim Colors() As Long
Dim DataPts() As Integer
'for filled polygons
Dim Points() As POINTAPI
Const PI = 3.14159265358979
Const Sin45 = .707106781186547
Const Cos45 = Sin45
Const Sin22_5 = .38268343236509
Const Cos22_5 = .923879532511287
Const Sin11_25 = .195090322016128
Const Cos11_25 = .98078528040323
Const HighMirror = 10
Function CheckIfValidSaver (NeedsMuchMemory As Integer) As Integer
'when in low memory mode the saver only runs the modules
'that draw on the screen, not those that manipulate
'bitmaps, savers that use more memory will pass
'NeedsMuchMemory as a non-zero value
If LowMemoryFlag = 0 Then 'if not low memory mode then done
CheckIfValidSaver = 1
Else
If NeedsMuchMemory <> 0 Then
LogFile ("Saver not valid in low memory: " + Str$(PlotType)), 0
NextSelection
CheckIfValidSaver = 0
Else
CheckIfValidSaver = 1
End If
End If
If Priorities(PlotType) = 0 Then
LogFile ("Saver disabled: " + Str$(PlotType)), 0
NextSelection
CheckIfValidSaver = 0
End If
End Function
Sub Circles ()
' have a single elipse trace across the
' screen with multiple previous copies following
' it
Dim xRadius As Integer, yRadius As Integer
Dim HighMirror As Integer
' if first time then initialize
If PlotInit = False Then
'see if we need to reset changes made from previous init
If PlotEnd = False Then
'check if saver is permitted to run
If CheckIfValidSaver(0) = 0 Then
Exit Sub
End If
PlotInit = True
Cls
ForeColor = QBColor(15)
'Set array size and clear the elements
ReDim x1a(MaxLines) As Integer
ReDim x2a(MaxLines) As Integer
ReDim y1a(MaxLines) As Integer
ReDim y2a(MaxLines) As Integer
Pointer = 1 ' start with array element 1
' set index to count number of times to repeat color
' to past maxvalue so that it will be recalculated
RepeatIndex = MaxLines + 1
'determine initial position of line
x1 = Rnd * ScaleWidth
x2 = Rnd * ScaleWidth
y1 = Rnd * ScaleHeight
y2 = Rnd * ScaleHeight
'set initial velocity
vx1 = 0
vx2 = 0
vy1 = 0
vy2 = 0
'set initial acceleration
ax1 = 0
ax2 = 0
ay1 = 0
ay2 = 0
'find background color
m = QBColor(0)
'Calculate velocity limits
MaxSpeedX = ScaleWidth * 15! / 800
MaxSpeedY = ScaleWidth * 15! / 600
'select mirroring method
HighMirror = 5
Mirror = Rnd * HighMirror + 1: If Mirror > HighMirror Then Mirror = 1
Else 'reset changes done by previous init
ClearScreen
'zero array sizes
ReDim x1a(0) As Integer
ReDim x2a(0) As Integer
ReDim y1a(0) As Integer
ReDim y2a(0) As Integer
End If
Else ' put run code here
Tick.Enabled = False' disable timer until circles completed
' check if time to get a new color
If RepeatIndex > RepeatCount Then
'set color
l = GetBrightNonGray()
RepeatIndex = 1
Else
RepeatIndex = RepeatIndex + 1
End If
'Delete original circle
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
End If
DoEvents
Select Case Mirror
Case 1: 'mirror on x and y axis
'Delete original circle mirrored on Y axis
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
End If
DoEvents
'Delete original circle mirrored on X axis
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
End If
DoEvents
'Delete original circle mirrored on origin
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
End If
DoEvents
Case 2: 'mirror on Y axis
'Delete original circle mirrored on Y axis
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
End If
DoEvents
Case 3: 'mirror around center point
'Delete original circle mirrored on origin
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
End If
DoEvents
Case Else: ' otherwise ignore (i.e. no mirror)
End Select
'Save New Circle
x1a(Pointer) = x1
x2a(Pointer) = x2
y1a(Pointer) = y1
y2a(Pointer) = y2
Select Case Mirror
Case 1: 'mirror on x and y axis
'Delete original circle mirrored on Y axis
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
End If
DoEvents
'Delete original circle mirrored on X axis
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
End If
DoEvents
'Delete original circle mirrored on origin
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
End If
Case 2: 'mirror on Y axis
'Delete original circle mirrored on y axis
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
End If
Case 3: 'mirror around center point
'Delete original circle mirrored on origin
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
End If
Case Else: ' otherwise ignore (i.e. no mirror)
End Select
DoEvents
Tick.Enabled = True' re-enable timer
'Draw new Circle
xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
If xRadius <> 0 Then
Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
End If
'Move pointer to next item
Pointer = Pointer + 1
If Pointer > MaxLines Then
Pointer = 1
End If
'determine new acceleration
ax1 = Rnd - .5
ax2 = Rnd - .5
ay1 = Rnd - .5
ay2 = Rnd - .5
'calculate new position
x1 = x1 + vx1
x2 = x2 + vx2
y1 = y1 + vy1
y2 = y2 + vy2
'calculate new velocity
vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
'check if off screen
If (x1 > ScaleWidth) Then
'change direction
vx1 = -Abs(vx1)
ElseIf (x1 < 0) Then
'change direction
vx1 = Abs(vx1)
End If
If (y1 > ScaleHeight) Then
'change direction
vy1 = -Abs(vy1)
ElseIf (y1 < 0) Then
'change direction
vy1 = Abs(vy1)
End If
If (x2 > ScaleWidth) Then
'change direction
vx2 = -Abs(vx2)
ElseIf (x2 < 0) Then
'change direction
vx2 = Abs(vx2)
End If
If (y2 > ScaleHeight) Then
'change direction
vy2 = -Abs(vy2)
ElseIf (y2 < 0) Then
'change direction
vy2 = Abs(vy2)
End If
End If
End Sub
Sub ClearScreen ()
'goes to extreme efforts to clear the screen
DC = CreateDC("DISPLAY", 0&, 0&, 0&)
'clear display
BitBlt DC, 0, 0, ScrnWidth, ScrnHeight, DC, 0, 0, &H42&
i = DeleteDC(DC)
picture = LoadPicture() ' clear picture
BackColor = QBColor(0)
Cls
End Sub
Sub Confetti ()
'put points on screen
'Dim i As Integer, j As Integer, k As Integer
Dim x As Integer, y As Integer
Dim Size As Integer
Dim UniformBoxes As Integer
' if first time then initialize
If PlotInit = False Then
'see if we need to reset changes made from previous init
If PlotEnd = False Then
'check if saver is permitted to run
If CheckIfValidSaver(0) = 0 Then
Exit Sub
End If
If LowMemoryFlag = 0 Then 'if not low memory mode then done
picture = original.Image ' start with original screen
Else
Cls
End If
PlotInit = True
Size = Rnd * 5 + 1
Else 'reset changes done by previous init
Tick.Enabled = True
picture = LoadPicture()
End If
Else
Tick.Enabled = False
Size = Rnd * 5 + 1 ' size to make dots
If Rnd > .5 Then
UniformBoxes = True
Else
UniformBoxes = False
End If
Do
x = Int(Rnd * ScrnWidth)
y = Int(Rnd * ScrnHeight)
Line (x, y)-(x + Size, y + Size), GetNearestColor(hDC, RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))), BF
If UniformBoxes = False Then
Size = Rnd ^ 10 * 40 + 2'new size
End If
DoEvents
CurrentTime = Timer
If (CurrentTime > MaxTime) Or (LastTime > CurrentTime) Then Exit Do
Loop
Tick.Enabled = True
picture = LoadPicture()
End If
End Sub
Sub CyclePalette ()
Dim Header As Long, DataBits As Long, i As Integer, j As Integer
Dim l As Long
Dim Paint As PAINTSTRUCT
Static Xoffset As Integer, Yoffset As Integer, red As Integer, green As Integer, blue As Integer
Static Wdth As Integer, Hght As Integer
Static FastPalRunFlag As Integer, PassFlag As Integer
Dim FileName As String, File As String
Static PaletteFlag As Integer
' if first time then initialize
If PlotInit = False Then
'see if we need to reset changes made from previous init
If PlotEnd = False Then
'check if saver is permitted to run
If CheckIfValidSaver(1) = 0 Then
Exit Sub
End If
'we only allow to run once since it has problems:
'if started more than once durring before program stops
'then resources can disappear drastically, there must
'be something about the animatepalette function or
'sendmessage that requires resources to be cleared?
If FastPalRunFlag Then
LogFile "Already ran Fast pallete cycle " + File, 1
NextSelection 'jump to next since there are no bitmap files in directory
Exit Sub
End If
'*****************************************************
'initialization code here:
File = GetNextFile(CycleBitmapsDir, 1, "dib", "gif", "")
If File = "" Then 'check if could not load
NextSelection 'jump to next since there are no bitmap files in directory
Exit Sub
End If
' find file
'FileSpec = RTrim$(BitmapsDir) + "\*.dib"
j = Rnd * 50 ' pick file at random
For i = 1 To j
File = GetNextFile(CycleBitmapsDir, 0, "dib", "gif", "")' get next file
Next i
'i = LoadSlide(File, 1)
'If i = 0 Then 'check if could not load
' LogFile "Could not load file " + File, 1
' NextSelection 'jump to next since there are no bitmap files in directory
' Exit Sub
'End If
If InStr(UCase$(File), ".GIF") = 0 Then
l = ManyDibLoad(File, Wdth, Hght)'load dib
If l <= 0 Then 'check if could not load
LogFile "Could not read DIB file " + File, 1
NextSelection 'jump to next since there are no bitmap files in directory
Exit Sub
End If
Else
l = ManyGifLoad(File, Wdth, Hght)'load gif
If l <= 0 Then 'check if could not load
LogFile "Could not read GIF file " + File, 1
NextSelection 'jump to next since there are no bitmap files in directory
Exit Sub
End If
End If
If (TotalNumColors <= 256) And (FastPaletteCycleFlag <> 0) Then
FastPalRunFlag = 1
'free up all but 2 system palettes
i = SetSystemPaletteUse(hDC, SYSPAL_NOSTATIC)
'show the palettes
SetWindow2DIBPalette PC_RESERVED
LogFile "Using Fast Palette Cycling", 0
PaletteFlag = 1
Else 'don't mess with palettes
'picture = LoadPicture() ' clear screen
LogFile "Changing Palette using screen redraws", 0
PaletteFlag = 0
End If
PassFlag = 2
PlotInit = True
'Cls
'position image
Xoffset = (ScrnWidth - Wdth) / 2
Yoffset = (ScrnHeight - Hght) / 2
'set tick rate
Tick.Interval = 25
Else 'reset changes done by previous init
If PaletteFlag <> 0 Then
'remove priority on palette entries
SetWindow2DIBPalette 0
i = SetSystemPaletteUse(hDC, SYSPAL_STATIC)'restore system palette
End If
'try to read last temp file for background
i = LoadSlideAndTile(RTrim$(BitmapsDir) + "\tmprary.dib")
'save current screen as new original
DC = CreateDC("DISPLAY", 0&, 0&, 0&)
BitBlt original.hDC, 0, 0, ScrnWidth, ScrnHeight, DC, 0, 0, &HCC0020
i = DeleteDC(DC)
ClearScreen
i = ManyDibFree() 'free memory used for dib
If i <> 0 Then
LogFile "Could not free memory", 1
End If
'set tick rate
Tick.Interval = 50
End If
Else ' put run code here
If PassFlag > 1 Then
Header = ManyDibGet() 'get pointer to header
DataBits = ManyDibGetData() 'get pointer to data
If Header <> 0 Then
i = SetStretchBltMode(hDC, 3)
i = StretchDIBits(hDC, 0, 0, ScrnWidth, ScrnHeight, 0, 0, Wdth, Hght, DataBits, Header, 0, &HCC0020)'source copy
Else
LogFile "Header missing", 1
NextSelection
Exit Sub
End If
PassFlag = PassFlag - 1
Else
Header = ManyDibGet() 'get pointer to header
DataBits = ManyDibGetData() 'get pointer to data
If Header <> 0 Then
If PaletteFlag <> 0 Then
DoAnimatePalette Pal, 1, 1'shift pallete by one
Else 'if not palette based, animate screen by
'changing colors and redrawing
'draw screen
i = SetStretchBltMode(hDC, 3)
ManyDibCyclePalette -1, 1, 255'cycle colors
'i = StretchDIBits(hDC, 0, 0, ScrnWidth, ScrnHeight, 0, 0, 640, 480, DataBits, Header, 0, &HCC0020)'source copy
i = SetDIBitsToDevice(hDC, Xoffset, Yoffset, Wdth, Hght, 0, 0, 0, Hght, DataBits, Header, 0)
End If
Else
LogFile "Header missing", 1
NextSelection
Exit Sub
End If
End If
End If
Exit Sub
End Sub
Sub DoAnimatePalette (palette As LOGPALETTE, Start As Integer, StepSize As Integer)
' cycle palete entry and display
Dim entrynum%, i As Integer
Dim usepal As Integer
Dim holdentry As PALETTEENTRY
Dim temp As Long
For i = 1 To StepSize'shift n times
' The following code simply loops the color values
LSet holdentry = palette.palPalEntry(Start)
For entrynum% = Start To PALENTRIES - 2
LSet palette.palPalEntry(entrynum%) = palette.palPalEntry(entrynum% + 1)
Next entrynum%
LSet palette.palPalEntry(PALENTRIES - 1) = holdentry
Next i
' Get a handle to the control's palette
On Error GoTo DoAnimatePaletteError
usepal = SendMessageByNum(hWnd, VBM_GETPALETTE, 0, 0)
On Error GoTo 0
AnimatePalette usepal, 0, PALENTRIES, palette.palPalEntry(0)
Exit Sub
DoAnimatePaletteError:
'overflow on getting palette handle
On Error GoTo 0
LogFile "Overflow on getting palette handle", 1
Exit Sub
End Sub
Sub Dribble ()
'dribbling paint on screen
Dim i As Integer, j As Integer, k As Integer
Static MaxHole As Integer
' if first time then initialize
If PlotInit = False Then
'see if we need to reset changes made from previous init
If PlotEnd = False Then
'check if saver is permitted to run
If CheckIfValidSaver(1) = 0 Then
Exit Sub
End If
' start with original screen
picture = original.Image
PlotInit = True
'determine initial position of shot
x1 = Rnd * ScaleWidth
y1 = Rnd * ScaleHeight
'Calculate velocity limits
MaxSpeedX = ScaleWidth * 20! / 800
MaxSpeedY = ScaleWidth * 20! / 600
' zero initial velocity
vx1 = 0: vy1 = 0
'set maximum size of holes
MaxHole = 4
ForeColor = RGB(0, 0, 0)' use black box
FillColor = RGB(0, 0, 0) 'set black fill
FillStyle = 0 'solid fill
RunMode = Int(Rnd * 2#)'choose black or color
'Debug.Print RunMode
If RunMode > 0 Then ' if random color then use larger spots
MaxHole = 8
i = Rnd * 255: If i > 255 Then i = 255
j = Rnd * 255: If j > 255 Then j = 255
k = Rnd * 255: If k > 255 Then k = 255
ForeColor = GetNearestColor(hDC, RGB(i, j, k))
FillColor = ForeColor
End If
Else 'reset changes done by previous init
ClearScreen
FillStyle = 1 'transparent fill
End If
Else ' put run code here
If RunMode > 0 Then ' see if need to change to random color
If Rnd < .05 Then
i = Rnd * 255: If i > 255 Then i = 255
j = Rnd * 255: If j > 255 Then j = 255
k = Rnd * 255: If k > 255 Then k = 255
ForeColor = GetNearestColor(hDC, RGB(i, j, k))
FillColor = ForeColor
End If
End If
' put random hole here
Circle (x1 + Rnd * 20, y1 + Rnd * 20), MaxHole * Rnd + 2, , , , 1
'determine new acceleration
ax1 = 2 * Rnd - 1
ay1 = 2 * Rnd - 1
'calculate new position
x1 = x1 + vx1
y1 = y1 + vy1
'calculate new velocity
vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = -vx1 * .9: vy1 = -vy1 * .9: ax1 = 0
vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vx1 = -vx1 * .9: vy1 = -vy1 * .9: ay1 = 0
'check if off screen
If (x1 > ScaleWidth) Then
'change direction
vx1 = -