home *** CD-ROM | disk | FTP | other *** search
- Type PegImage From Image
- Dim PegID As Integer
-
- ' METHODS for object: PegImage
- Sub MouseDown(button, shift As Integer, x,y As Single)
- ' If there is no parent for this object, then don't do anything
- If Not Parent Then Exit Sub
-
- ' If the game has not been started, remove the first peg
- If Not Parent.GameStarted Then
- Picture = Parent.bmpNoPeg
- Refresh
- Parent.GameStarted = -1
- Parent.lblNotice.Caption = "Game is in progress..."
- End If
- End Sub
-
- Sub HasPeg(peg_count As Integer)
- ' This routine checks to see if there is a peg in the control
- If Not Parent Then Exit Sub
-
- If Picture == Parent.bmpPeg Then
- peg_count = peg_count + 1
- End If
-
- End Sub
-
- Sub DragAndDrop(source As XferData, x,y As Single, state As OleDropState, effect As OleDropEffect)
- ' If there is no parent for this object, then don't do anything
- If Not Parent Then Exit Sub
-
- ' Image is dropped onto image control
- If state == 3 Then
- If Picture == Parent.bmpPeg Then
- effect = 0
- Exit Sub
- End If
- If Parent.ValidMove(PegID) Then
- ' allow drop to take place
- Picture = Parent.bmpPeg
- Else
- effect = 0
- End If
- End If
- End Sub
-
- Sub DragStart(o as XferData, x,y As Single)
-
- ' If there is no parent for this object, then don't do anything
- If Not Parent Then Exit Sub
-
- If Parent.GameStarted And Picture == Parent.bmpPeg Then
- Picture = Parent.bmpNoPeg
- Parent.DragSource = PegID
- If o.Drag(2) <> 2 Then
- Picture = Parent.bmpPeg
- Else
- Parent.MoveOver
- End If
- End If
- End Sub
-
- Sub PegInit()
- ' If there is no parent for this object, then don't do anything
- If Not Parent Then Exit Sub
-
- ' Initialize the picture to show
- Picture = Parent.bmpPeg
- End Sub
-
- End Type
-
- Type GamePegMasterForm From SampleMasterForm
- Dim imgLabel As New Image
- Dim lblNotice As New Label
- Dim bmpPeg As New Bitmap
- Dim bmpNoPeg As New Bitmap
- Dim GameStarted As Integer
- Dim DragSource As String
- Dim img0 As New PegImage
- Dim img1 As New PegImage
- Dim img2 As New PegImage
- Dim img3 As New PegImage
- Dim img4 As New PegImage
- Dim img5 As New PegImage
- Dim img6 As New PegImage
- Dim img7 As New PegImage
- Dim img8 As New PegImage
- Dim img9 As New PegImage
- Dim img10 As New PegImage
- Dim img11 As New PegImage
- Dim img12 As New PegImage
- Dim img13 As New PegImage
- Dim img14 As New PegImage
- Dim img15 As New PegImage
- Dim img16 As New PegImage
-
- ' METHODS for object: GamePegMasterForm
- Sub Resize()
- End Sub
-
- Sub DragAndDrop(source As XferData, x,y As Single, state As OleDropState, effect As OleDropEffect)
- ' Image is dropped onto image 6
- If state == 3 Then
- effect = 0
- End If
- End Sub
-
- Function GetPictureName (img As Integer) As String
- ' Based on the image control number passed to this routine
- ' return the associated picture bitmap
- Select Case img
- Case 0
- GetPictureName = img0.Picture
- Case 1
- GetPictureName = img1.Picture
- Case 2
- GetPictureName = img2.Picture
- Case 3
- GetPictureName = img3.Picture
- Case 4
- GetPictureName = img4.Picture
- Case 5
- GetPictureName = img5.Picture
- Case 6
- GetPictureName = img6.Picture
- Case 7
- GetPictureName = img7.Picture
- Case 8
- GetPictureName = img8.Picture
- Case 9
- GetPictureName = img9.Picture
- Case 10
- GetPictureName = img10.Picture
- Case 11
- GetPictureName = img11.Picture
- Case 12
- GetPictureName = img12.Picture
- Case 13
- GetPictureName = img13.Picture
- Case 14
- GetPictureName = img14.Picture
- Case 15
- GetPictureName = img15.Picture
- Case 16
- GetPictureName = img16.Picture
- End Select
- End Function
-
- Function ValidMove(pos As Integer) As Integer
- Dim valid_move As Integer
-
- ' Initialize the valid flag
- valid_move = 1
-
- ' Checks the validity of the move
- Select Case pos
- Case 0
- If DragSource == "10" And img5.Picture == bmpPeg Then
- img5.Picture = bmpNoPeg
- ElseIf DragSource == "6" And img3.Picture == bmpPeg Then
- img3.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 1
- If DragSource == "5" And img3.Picture == bmpPeg Then
- img3.Picture = bmpNoPeg
- ElseIf DragSource == "11" And img6.Picture == bmpPeg Then
- img6.Picture = bmpNoPeg
- ElseIf DragSource == "7" And img4.Picture == bmpPeg Then
- img4.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 2
- If DragSource == "6" And img4.Picture == bmpPeg Then
- img4.Picture = bmpNoPeg
- ElseIf DragSource == "12" And img7.Picture == bmpPeg Then
- img7.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 3
- If DragSource == "13" And img8.Picture == bmpPeg Then
- img8.Picture = bmpNoPeg
- ElseIf DragSource == "9" And img6.Picture == bmpPeg Then
- img6.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 4
- If DragSource == "8" And img6.Picture == bmpPeg Then
- img6.Picture = bmpNoPeg
- ElseIf DragSource == "14" And img9.Picture == bmpPeg Then
- img9.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 5
- If DragSource == "15" And img10.Picture == bmpPeg Then
- img10.Picture = bmpNoPeg
- ElseIf DragSource == "11" And img8.Picture == bmpPeg Then
- img8.Picture = bmpNoPeg
- ElseIf DragSource == "1" And img3.Picture == bmpPeg Then
- img3.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 6
- If DragSource == "0" And img3.Picture == bmpPeg Then
- img3.Picture = bmpNoPeg
- ElseIf DragSource == "2" And img4.Picture == bmpPeg Then
- img4.Picture = bmpNoPeg
- ElseIf DragSource == "10" And img8.Picture == bmpPeg Then
- img8.Picture = bmpNoPeg
- ElseIf DragSource == "12" And img9.Picture == bmpPeg Then
- img9.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 7
- If DragSource == "1" And img4.Picture == bmpPeg Then
- img4.Picture = bmpNoPeg
- ElseIf DragSource == "11" And img9.Picture == bmpPeg Then
- img9.Picture = bmpNoPeg
- ElseIf DragSource == "16" And img12.Picture == bmpPeg Then
- img12.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 8
- If DragSource == "4" And img6.Picture == bmpPeg Then
- img6.Picture = bmpNoPeg
- ElseIf DragSource == "14" And img11.Picture == bmpPeg Then
- img11.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 9
- If DragSource == "3" And img6.Picture == bmpPeg Then
- img6.Picture = bmpNoPeg
- ElseIf DragSource == "13" And img11.Picture == bmpPeg Then
- img11.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 10
- If DragSource == "0" And img5.Picture == bmpPeg Then
- img5.Picture = bmpNoPeg
- ElseIf DragSource == "6" And img8.Picture == bmpPeg Then
- img8.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 11
- If DragSource == "5" And img8.Picture == bmpPeg Then
- img8.Picture = bmpNoPeg
- ElseIf DragSource == "15" And img13.Picture == bmpPeg Then
- img13.Picture = bmpNoPeg
- ElseIf DragSource == "1" And img6.Picture == bmpPeg Then
- img6.Picture = bmpNoPeg
- ElseIf DragSource == "7" And img9.Picture == bmpPeg Then
- img9.Picture = bmpNoPeg
- ElseIf DragSource == "16" And img14.Picture == bmpPeg Then
- img14.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 12
- If DragSource == "6" And img9.Picture == bmpPeg Then
- img9.Picture = bmpNoPeg
- ElseIf DragSource == "2" And img7.Picture == bmpPeg Then
- img7.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 13
- If DragSource == "3" And img8.Picture == bmpPeg Then
- img8.Picture = bmpNoPeg
- ElseIf DragSource == "9" And img11.Picture == bmpPeg Then
- img11.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 14
- If DragSource == "8" And img11.Picture == bmpPeg Then
- img11.Picture = bmpNoPeg
- ElseIf DragSource == "4" And img9.Picture == bmpPeg Then
- img9.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 15
- If DragSource == "5" And img10.Picture == bmpPeg Then
- img10.Picture = bmpNoPeg
- ElseIf DragSource == "11" And img13.Picture == bmpPeg Then
- img13.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- Case 16
- If DragSource == "11" And img14.Picture == bmpPeg Then
- img14.Picture = bmpNoPeg
- ElseIf DragSource == "7" And img12.Picture == bmpPeg Then
- img12.Picture = bmpNoPeg
- Else
- valid_move = 0
- End If
- End Select
-
- If valid_move == 0 Then
- ValidMove = 0
- Else
- ValidMove = 1
- End If
-
- End Function
-
- Function MoreMoves() As Integer
- ' Determine if there are any additional moves possible
- If MoveOK(0, 5, 10) Then
- MoreMoves = -1
- ElseIf MoveOK(0, 3, 6) Then
- MoreMoves = -1
- ElseIf MoveOK(2, 7, 12) Then
- MoreMoves = -1
- ElseIf MoveOK(2, 4, 6) Then
- MoreMoves = -1
- ElseIf MoveOK(1, 3, 5) Then
- MoreMoves = -1
- ElseIf MoveOK(1, 4, 7) Then
- MoreMoves = -1
- ElseIf MoveOK(3, 6, 9) Then
- MoreMoves = -1
- ElseIf MoveOK(4, 6, 8) Then
- MoreMoves = -1
- ElseIf MoveOK(5, 8, 11) Then
- MoreMoves = -1
- ElseIf MoveOK(6, 8, 10) Then
- MoreMoves = -1
- ElseIf MoveOK(6, 9, 12) Then
- MoreMoves = -1
- ElseIf MoveOK(7, 9, 11) Then
- MoreMoves = -1
- ElseIf MoveOK(11, 13, 15) Then
- MoreMoves = -1
- ElseIf MoveOK(11, 14, 16) Then
- MoreMoves = -1
- ElseIf MoveOK(9, 11, 13) Then
- MoreMoves = -1
- ElseIf MoveOK(8, 11, 14) Then
- MoreMoves = -1
- ElseIf MoveOK(5, 10, 15) Then
- MoreMoves = -1
- ElseIf MoveOK(7, 12, 16) Then
- MoreMoves = -1
- ElseIf MoveOK(3, 8, 13) Then
- MoreMoves = -1
- ElseIf MoveOK(1, 6, 11) Then
- MoreMoves = -1
- ElseIf MoveOK(4, 9, 14) Then
- MoreMoves = -1
- Else
- MoreMoves = 0
- End If
-
- End Function
-
- Function MoveOK(No1 As Integer, No2 As Integer, No3 As Integer) As Integer
- Dim bmp1 As String
- Dim bmp2 As String
- Dim bmp3 As String
-
- ' Get the names of the bitmaps in the designated image controls
- bmp1 = GetPictureName(No1)
- bmp2 = GetPictureName(No2)
- bmp3 = GetPictureName(No3)
-
- ' Check to see if this sequence and the reverse jump sequence is valid or not
- If bmp1 == "GamePegMasterForm.bmpPeg" And bmp2 == "GamePegMasterForm.bmpPeg" And bmp3 == "GamePegMasterForm.bmpNoPeg" Then
- MoveOK = -1
- ElseIf bmp3 == "GamePegMasterForm.bmpPeg" And bmp2 == "GamePegMasterForm.bmpPeg" And bmp1 == "GamePegMasterForm.bmpNoPeg" Then
- MoveOK = -1
- Else
- MoveOK = 0
- End If
-
- End Function
-
- Sub MoveOver()
- Dim peg_count As Integer
- Dim message As String
-
- ' Determine if there are any more moves possible
- If Not MoreMoves() Then
- ' No more move are possible so let's count whats left over
- peg_count = 0
-
- ' Ask all controls if they have a peg and if so, increment the peg_count variable
- Controls.HasPeg(peg_count)
-
- Select Case peg_count
- Case 1
- message = "General"
- Case 2
- message = "Colonel"
- Case 3
- message = "Captain"
- Case 4
- message = "Lieutenant"
- Case 5
- message = "Sergeant"
- Case Else
- message = "Private"
- End Select
-
- ' Let the user know how he did
- lblNotice.Caption = "Game Over!" & Chr(13) & Chr(10) & "Your rank is: " & message
-
- End If
- End Sub
-
- Sub ResetApplication_Click ()
-
- ' Initialize the scales of all images
- Controls.PegInit
-
- ' Initialize game flags
- GameStarted = 0
-
- ' Let the user know what's going on
- lblNotice.Caption = "Click to remove first peg..."
-
- ' Size the form to match the bitmap
- GamePegMasterForm.Width = 3570
- GamePegMasterForm.Height = 4440
-
- Controls.Refresh
-
- End Sub
-
- End Type
-
- Begin Code
- ' Reconstruction commands for object: PegImage
- '
- With PegImage
- .DragMode := "LeftMouse"
- .Move(0, 0, 0, 0)
- .AutoInitCropRect := False
- .ResizeMode := "Clip"
- .ScrollBars := "Never"
- .ScaleX := 1
- .ScaleY := 1
- .PegID := 0
- End With 'PegImage
- ' Reconstruction commands for object: GamePegMasterForm
- '
- With GamePegMasterForm
- .Caption := "Pegs Game"
- .Move(9015, 2010, 3570, 4440)
- .GameStarted := 0
- .DragSource := "6"
- .SampleDir := "W:\arsenal\apps\gamepeg\"
- .SampleName := "gamepeg"
- With .imgLabel
- .Caption := "imgLabel"
- .ZOrder := 2
- .Move(300, 2850, 2850, 585)
- End With 'GamePegMasterForm.imgLabel
- With .lblNotice
- .Caption := "Click to remove first peg..."
- .ZOrder := 1
- .Move(450, 2895, 2550, 495)
- .Alignment := "Center"
- End With 'GamePegMasterForm.lblNotice
- With .bmpPeg
- .LoadType := "MemoryBased"
- .FileName := "gamepeg.ero"
- .ResId := 0
- End With 'GamePegMasterForm.bmpPeg
- With .bmpNoPeg
- .LoadType := "MemoryBased"
- .FileName := "gamepeg.ero"
- .ResId := 628
- End With 'GamePegMasterForm.bmpNoPeg
- With .img0
- .Caption := "img0"
- .DragMode := "RightMouse"
- .ZOrder := 3
- .Move(300, 300, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- End With 'GamePegMasterForm.img0
- With .img1
- .Caption := "img1"
- .DragMode := "RightMouse"
- .ZOrder := 4
- .Move(1500, 300, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 1
- End With 'GamePegMasterForm.img1
- With .img2
- .Caption := "img2"
- .DragMode := "RightMouse"
- .ZOrder := 5
- .Move(2700, 300, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 2
- End With 'GamePegMasterForm.img2
- With .img3
- .Caption := "img3"
- .DragMode := "RightMouse"
- .ZOrder := 6
- .Move(900, 600, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 3
- End With 'GamePegMasterForm.img3
- With .img4
- .Caption := "img4"
- .DragMode := "RightMouse"
- .ZOrder := 7
- .Move(2100, 600, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 4
- End With 'GamePegMasterForm.img4
- With .img5
- .Caption := "img5"
- .DragMode := "RightMouse"
- .ZOrder := 8
- .Move(300, 900, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 5
- End With 'GamePegMasterForm.img5
- With .img6
- .Caption := "img6"
- .DragMode := "RightMouse"
- .ZOrder := 9
- .Move(1500, 900, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 6
- End With 'GamePegMasterForm.img6
- With .img7
- .Caption := "img7"
- .DragMode := "RightMouse"
- .ZOrder := 10
- .Move(2700, 900, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 7
- End With 'GamePegMasterForm.img7
- With .img8
- .Caption := "img8"
- .DragMode := "RightMouse"
- .ZOrder := 11
- .Move(900, 1200, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 8
- End With 'GamePegMasterForm.img8
- With .img9
- .Caption := "img9"
- .DragMode := "RightMouse"
- .ZOrder := 12
- .Move(2100, 1200, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 9
- End With 'GamePegMasterForm.img9
- With .img10
- .Caption := "img10"
- .DragMode := "RightMouse"
- .ZOrder := 13
- .Move(300, 1500, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 10
- End With 'GamePegMasterForm.img10
- With .img11
- .Caption := "img11"
- .DragMode := "RightMouse"
- .ZOrder := 14
- .Move(1500, 1500, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 11
- End With 'GamePegMasterForm.img11
- With .img12
- .Caption := "img12"
- .DragMode := "RightMouse"
- .ZOrder := 15
- .Move(2700, 1500, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 12
- End With 'GamePegMasterForm.img12
- With .img13
- .Caption := "img13"
- .DragMode := "RightMouse"
- .ZOrder := 16
- .Move(900, 1800, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 13
- End With 'GamePegMasterForm.img13
- With .img14
- .Caption := "img14"
- .DragMode := "RightMouse"
- .ZOrder := 17
- .Move(2100, 1800, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 14
- End With 'GamePegMasterForm.img14
- With .img15
- .Caption := "img15"
- .DragMode := "RightMouse"
- .ZOrder := 18
- .Move(300, 2100, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 15
- End With 'GamePegMasterForm.img15
- With .img16
- .Caption := "img16"
- .DragMode := "RightMouse"
- .ZOrder := 19
- .Move(2700, 2100, 480, 480)
- .Picture := GamePegMasterForm.bmpPeg
- .PegID := 16
- End With 'GamePegMasterForm.img16
- With .helpfile
- .FileName := "W:\arsenal\apps\gamepeg\gamepeg.hlp"
- End With 'GamePegMasterForm.helpfile
- End With 'GamePegMasterForm
- End Code
-