Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/joystick/game.frm

Visual Basic Form | 1993-09-05 | 11.4 KB | 354 lines

VERSION 2.00
Begin Form gameform
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Joystick Skeet Shoot"
   ClientHeight    =   8490
   ClientLeft      =   1005
   ClientTop       =   1695
   ClientWidth     =   10455
   Height          =   9150
   Left            =   960
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8490
   ScaleWidth      =   10455
   Top             =   1080
   Width           =   10545
   Begin Joystick Joystick1
      Left            =   120
      Top             =   7920
   End
   Begin Line Line1
      BorderColor     =   &H00000000&
      BorderWidth     =   2
      X1              =   0
      X2              =   10440
      Y1              =   7680
      Y2              =   7680
   End
   Begin Label Label4
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "SCORE"
      Height          =   255
      Left            =   6240
      TabIndex        =   3
      Top             =   7800
      Width           =   3495
   End
   Begin Label Label3
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "SHOTS"
      Height          =   255
      Left            =   1440
      TabIndex        =   2
      Top             =   7800
      Width           =   2535
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "0"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   1560
      TabIndex        =   1
      Top             =   8160
      Width           =   2295
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "0000"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   255
      Left            =   6360
      TabIndex        =   0
      Top             =   8160
      Width           =   3255
   End
   Begin Menu mnugame
      Caption         =   "&Game"
      Begin Menu mnunew
         Caption         =   "&New"
         Shortcut        =   {F2}
      End
      Begin Menu mnupause
         Caption         =   "&Pause"
         Shortcut        =   {F3}
      End
      Begin Menu mnustop
         Caption         =   "&Exit"
         Shortcut        =   {F4}
      End
   End
   Begin Menu mnuoptions
      Caption         =   "&Options"
      Begin Menu mnuspeed
         Caption         =   "&Speed"
         Begin Menu mnufast
            Caption         =   "&Fast"
            Index           =   0
         End
         Begin Menu mnufast
            Caption         =   "&Medium"
            Index           =   1
         End
         Begin Menu mnufast
            Caption         =   "&Slow"
            Checked         =   -1  'True
            Index           =   2
         End
      End
      Begin Menu mnutargets
         Caption         =   "&Targets"
         Begin Menu mnumultiple
            Caption         =   "&Single"
            Checked         =   -1  'True
            Index           =   0
         End
         Begin Menu mnumultiple
            Caption         =   "&Multiple"
            Index           =   1
         End
      End
   End
DefInt A-Z
Dim tsize As Integer
Dim tdelay As Integer
Dim tcount As Integer
Dim targetx As Integer
Dim targety As Integer
Dim capcolor As Long
Dim score As Long
Dim lppoint As pointapi
Dim kill_target As Integer
Dim shots As Integer
Dim master_time As Single
Dim game_over As Integer
Dim pause_flag As Integer
Dim target(1 To 3) As target_data
Sub draw_target (x As Integer, y As Integer, cqb)
    'Debug.Print x, y, cqb
    gameform.DrawMode = 7' xor mode
    gameform.Line (x, y)-(x + tsize, y + tsize), QBColor(cqb), BF
End Sub
Sub Form_Load ()
tsize = 500
tdelay = 4
tcount = 1
xmax = 20000
ymax = 20000
xmin = 0
ymin = 0
calx = 0
caly = 0
button_mark = False
mousepointer = 2
shots = 50
winxmax = gameform.ScaleLeft + gameform.ScaleWidth
winxmin = gameform.ScaleLeft
winymin = gameform.ScaleTop
winymax = gameform.ScaleTop + gameform.ScaleHeight
joystick1.Capture = True
xmax = getprivateprofileint("gameform", "xmax", -1, "joytest.ini")
If xmax = -1 Then
    need_calibrate = True
    xmin = getprivateprofileint("gameform", "xmin", -1, "joytest.ini")
    ymax = getprivateprofileint("gameform", "ymax", -1, "joytest.ini")
    ymin = getprivateprofileint("gameform", "ymin", -1, "joytest.ini")
End If
deltax = gameform.ScaleWidth / xmax
deltay = gameform.ScaleHeight / ymax
loop_count = 0
    time1! = Timer
    count1 = 0
    Do
        DoEvents
        count1 = count1 + 1
    Loop While Timer - time1! < 1
loop_time = loop_time + count1
loop_count = loop_count + 1
Loop While loop_count < 2
master_time = Int(loop_time / loop_count)
Randomize
game_over = False
End Sub
Sub Joystick1_ButtonDown (button As Integer)
button_mark = True
If need_calibrate Then Exit Sub
    Select Case button
        Case 1
            'Circle (winpoint.x, winpoint.y), 80, RGB(0, 0, 0)
            'fillcolor = QBColor(0)
        Case 2
            'picture2.Circle (winpoint.x, winpoint.y), 80, RGB(0, 0, 0)
            'fillcolor = QBColor(0)
            getcursorpos lppoint

            ScreenToClient gameform.hWnd, lppoint
            lppoint.x = lppoint.x * screen.TwipsPerPixelX
            lppoint.y = lppoint.y * screen.TwipsPerPixelY
            For i = 1 To tcount
                If lppoint.x > target(i).x And lppoint.x < target(i).x + tsize Then
                    If lppoint.y > target(i).y And lppoint.y < target(i).y + tsize Then
                        Beep
                        score = score + 10 * tdelay
                        label1.Caption = Str(score)
                        target(i).kill_target = True
                    End If
                End If
            Next i
            shots = shots - 1
            label2.Caption = Str(shots)
            If shots = 0 Then
            game_over = True
            MsgBox "Game Over!", 0, "Joystick Skeet Shoot"
            End If
    End Select
End Sub
Sub Joystick1_Move (x As Integer, y As Integer, z As Integer)
    calx = x
    caly = y
    If need_calibrate Then
        Call calibrate(gameform)
        If need_calibrate <> True Then
            t = writeprivateprofilestring("gameform", "xmax", ByVal Format$(xmax), "joytest.ini")
            t = writeprivateprofilestring("gameform", "ymax", ByVal Format$(ymax), "joytest.ini")
            t = writeprivateprofilestring("gameform", "xmin", ByVal Format$(xmin), "joytest.ini")
            t = writeprivateprofilestring("gameform", "ymin", ByVal Format$(ymin), "joytest.ini")
        End If
        Exit Sub
    End If
    convert x, y, gameform
    'Debug.Print "* "; winpoint.x, winpoint.y
End Sub
Sub mnufast_Click (index As Integer)
Select Case index
    Case 0' fast
        tdelay = 8
        mnufast(1).Checked = False
        mnufast(2).Checked = False
    Case 1' medium
        tdelay = 4
        mnufast(0).Checked = False
        mnufast(2).Checked = False
    Case 2' slow
        tdelay = 2
        mnufast(0).Checked = True
        mnufast(1).Checked = True
End Select
mnufast(index).Checked = True
End Sub
Sub mnumultiple_Click (index As Integer)
Select Case index
    Case 0
        tcount = 1
    Case 1
        tcount = 2
End Select
End Sub
Sub mnunew_Click ()
game_over = False
score = 0
shots = 50
label1.Caption = Str(score)
label2.Caption = Str(shots)
'****************************************
' Create the targets
'****************************************
            Do
                c1 = Int(15 * Rnd)
            Loop While c1 = 7' don't allow white target
            target(1).color = c1
            target(2).color = c1
    For i = 1 To tcount
            If i = 1 Then

                target(i).x = Int(((gameform.Width - tsize - gameform.Left + 1) * Rnd / 2) + gameform.Left)
                target(i).y = gameform.ScaleTop + gameform.ScaleHeight - Int((gameform.ScaleTop + gameform.ScaleHeight) / 4)
                draw_target target(i).x, target(i).y, target(i).color
            Else

                target(i).x = target(i - 1).x - 2 * tsize
                target(i).y = target(i - 1).y - 2 * tsize
                draw_target target(i).x, target(i).y, target(i).color
            End If
            dummy = DoEvents()
            ' draw a target

            target(i).dx = Int(100 * Rnd + 50)
            target(i).dy = -Int(100 * Rnd + 50)
            Do
                target(i).dxm = Int(3 * Rnd - 1)

            Loop While target(i).dxm = 0
            target(i).dx = target(i).dx * target(i).dxm
            target(i).kill_target = False
            target(i).valid = True

    Next i
'*******************************************
' if paused, wait till cleared
'*******************************************
            Do
                DoEvents
            Loop While pause_flag = True
'*******************************************
' delay between movements
'*******************************************
            loop_count = 0
            Do
                DoEvents
                loop_count = loop_count + 1
            Loop Until loop_count = Int(master_time / tdelay)
'******************************************
' move target(s)
'******************************************
        For i = 1 To tcount
            If target(i).kill_target = True Then
                draw_target target(i).x, target(i).y, c1' erase the target
                target(i).kill_target = False
                target(i).valid = False
            End If
        Next i
        For i = 1 To tcount
            If target(i).valid = True Then
                draw_target target(i).x, target(i).y, c1' erase target
                target(i).x = target(i).x + target(i).dx          ' move target
                If target(i).x + tsize < gameform.ScaleLeft Then target(i).kill_target = True
                If target(i).x > gameform.ScaleWidth Then target(i).kill_target = True
                target(i).y = target(i).y + target(i).dy
                If target(i).y + tsize < gameform.ScaleTop Then target(i).kill_target = True
                If target(i).y > gameform.ScaleHeight Then target(i).kill_target = True
                draw_target target(i).x, target(i).y, c1' redraw target
            End If
        Next i
    count1 = 0
    For i = 1 To tcount
        If target(i).valid = True Then count1 = count1 + 1
    Next i
Loop While count1 <> 0 And game_over = False
Loop While shots <> 0
If game_over Then End
End Sub
Sub mnupause_Click ()
pause_flag = Not pause_flag
End Sub
Sub mnustop_Click ()
End Sub