CarMouse

Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
Const pi = 3.14159265358979
Private Type xy_type 'a type I often use
x As Single
y As Single
End Type
Private Type POINTAPI 'the GetCursorPos-API needs this type
x As Long
y As Long
End Type
Dim color(1 To 19, 1 To 29) As Integer 'an array of color values
Private Function draw_point(angle As Single, radius As Single, _
xmid As Single, ymid As Single)
As xy_type
'this function returns the x and y coordinate from a middlepoint

draw_point.x = Int(xmid + Sin(angle / 180 * pi) * radius)
draw_point.y = Int(ymid - Cos(angle / 180 * pi) * radius)
End Function

Private Function get_angle(xmid As Single, ymid As Single, x As Single, y As Single) As Single
If x > xmid And y > ymid Then _
get_angle = 90 + Atn(Abs(y - ymid) / Abs(x - xmid)) / pi * 180 'lower-right
If x > xmid And y = ymid Then get_angle = 90 'right

If x > xmid And y < ymid Then _
get_angle = 90 - Atn(Abs(y - ymid) / Abs(x - xmid)) / pi * 180 'upper-right

If x = xmid And y < ymid Then get_angle = 0 'upper
If x = xmid And y > ymid Then get_angle = 180'lower

If x < xmid And y > ymid Then _
get_angle = 270 - Atn(Abs(y - ymid) / Abs(x - xmid)) / pi * 180 'lower-left

If x < xmid And y = ymid Then get_angle = 270'left

If x < xmid And y < ymid Then _
get_angle = 270 + Atn(Abs(y - ymid) / Abs(x - xmid)) / pi * 180 'upper-left
End Function

Private Function distance(x1 As Single, y1 As Single, x2 As Single, y2 As Single) As Single
'pythagoras

distance = Sqr(Abs(x1 - x2) ^ 2 + Abs(y1 - y2) ^ 2)
End Function

Private Sub load_car(filename As String)
'This sub loads a car-file, it should be 19x29. Check the

'car.txt in your windows-desktop after running this program.

Dim x As Integer, y As Integer
Open filename For Input As #1
For y = 1 To 29
Line Input #1, regel
For x = 1 To 19
color(x, y) = Asc(Mid(regel, x, 1)) - 65
Next x
Next y
Close #1
End Sub

Private Sub Form_Load()
Dim xpos As Single, ypos As Single
Dim angle As Integer, speed As Integer
Dim x As Single, y As Single
Dim mousepos As xy_type
Dim tempmousepos As POINTAPI
Dim coords(1 To 19, 1 To 29) As xy_type

Me.WindowState = vbMaximized
Me.ScaleMode = vbPixels
Me.Show

createfile "c:\windows\desktop\car.txt"
load_car "c:\windows\desktop\car.txt"

speed = 5
xpos = Me.ScaleWidth / 2
ypos = Me.ScaleHeight / 2
Do
DoEvents
If GetAsyncKeyState(vbKeyLeft) Then
angle = angle - 5: If angle < 0 Then angle = angle + 360
End If

If GetAsyncKeyState(vbKeyRight) Then
angle = angle + 5: If angle > 359 Then angle = angle - 360
End If

If GetAsyncKeyState(vbKeyUp) And speed <= 5 Then speed = speed + 1
If GetAsyncKeyState(vbKeyDown) And speed > 0 Then speed = speed - 1

GetCursorPos tempmousepos
mousepos.x = tempmousepos.x
mousepos.y = tempmousepos.y
mouseangle = get_angle(xpos + 9, ypos + 14, mousepos.x, mousepos.y)

If angle - mouseangle < 0 Then _
angle_dif_right = (360 - mouseangle) + angle Else angle_dif_right = angle - mouseangle
If mouseangle - angle < 0 Then _
angle_dif_left = (360 - angle) + mouseangle Else angle_dif_left = mouseangle - angle
If angle_dif_left < angle_dif_right Then angle = angle + angle_dif_left / 5
If angle_dif_right < angle_dif_left Then angle = angle - angle_dif_right / 5
If angle > 359 Then angle = angle - 360
If angle < 0 Then angle = angle + 360

xpos = xpos + Sin(angle / 180 * pi) * speed
ypos = ypos - Cos(angle / 180 * pi) * speed

For x = 1 To 19
For y = 1 To 29
coords(x, y) = draw_point(get_angle(9, 14, x, y) + _
angle, distance(x, y, 9, 14), xpos + 9, ypos + 14)
Next y
Next x
Cls
For x = 1 To 19
For y = 1 To 29
If color(x, y) <> 7 Then
PSet (coords(x, y).x, coords(x, y).y), QBColor(color(x, y))
End If
Next y
Next x
Loop
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Sub createfile(filename As String)
'creates a car for this file

Open filename For Output As #1
Print #1, "HAAAAAAAAAAAAAAAAAH"
Print #1, "AOOOOMMMMMMMMMOOOOA"
Print #1, "AMMMMMMMMMMMMMMMMMA"
Print #1, "AOMMMMMMMMMMMMMMMOA"
Print #1, "AOMMMMMMMMMMMMMMMOA"
Print #1, "AMMMMMMMMMMMMMMMMMA"
Print #1, "AMMMMMMMMMMMMMMMMMA"
Print #1, "AMMMMMMMMMMMMMMMMMA"
Print #1, "AMAAAAAAAAAAAAAAAMA"
Print #1, "AMAJJJJJJJJJJJJJAMA"
Print #1, "AAAJJJJJJJJJJJJJAAA"
Print #1, "AJAAAAAAAAAAAAAAAJA"
Print #1, "AJAMMMMMMMMMMMMMAJA"
Print #1, "AJAMMMMMMMMMMMMMAJA"
Print #1, "AAAMMMMMMMMMMMMMAAA"
Print #1, "AMAMMMMMMMMMMMMMAMA"
Print #1, "AAAMMMMMMMMMMMMMAAA"
Print #1, "AJAMMMMMMMMMMMMMAJA"
Print #1, "AJAMMMMMMMMMMMMMAJA"
Print #1, "AJAMMMMMMMMMMMMMAJA"
Print #1, "AJAAAAAAAAAAAAAAAAA"
Print #1, "AAAJJJJJJJJJJJJJAMA"
Print #1, "AMAAAAAAAAAAAAAAAMA"
Print #1, "AMMMMMMMMMMMMMMMMMA"
Print #1, "AMMMMMMMMMMMMMMMMMA"
Print #1, "AMMMMMMMMMMMMMMMMMA"
Print #1, "AMMMMMMMMMMMMMMMMMA"
Print #1, "AOAAAMMMMMMMMMAAAOA"
Print #1, "HAMMMAAAAAAAAAMMMAH"
Close #1
End Sub