form1.frm

软件名称： 迷宫游戏源程序

VERSION 4.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3315
   ClientLeft      =   1140
   ClientTop       =   1515
   ClientWidth     =   4230
   Height          =   3720
   Left            =   1080
   LinkTopic       =   "Form1"
   ScaleHeight     =   3315
   ScaleWidth      =   4230
   Top             =   1170
   Width           =   4350
   Begin VB.PictureBox picPlayer 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   225
      Left            =   480
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   225
      ScaleWidth      =   225
      TabIndex        =   0
      Top             =   360
      Width           =   225
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

' The maze information.
Private NumRows As Integer
Private NumCols As Integer
Private LegalMove() As Boolean

' The size of a square.
Private Const SQUARE_WID = 20
Private Const SQUARE_HGT = 20

' The player's position.
Private PlayerR As Integer
Private PlayerC As Integer

' The end position.
Private RFinish As Integer
Private CFinish As Integer

Private StartTime As Single

' Look for movement keys.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim r As Integer
Dim c As Integer

    r = PlayerR
    c = PlayerC
    Select Case KeyCode
        Case vbKeyLeft
            c = PlayerC - 1
        Case vbKeyRight
            c = PlayerC + 1
        Case vbKeyDown
            r = PlayerR + 1
        Case vbKeyUp
            r = PlayerR - 1
        Case Else
            Exit Sub
    End Select

    If LegalMove(r, c) Then PositionPlayer r, c
End Sub

' Initialize the maze and player.
Private Sub Form_Load()
    ScaleMode = vbPixels
    AutoRedraw = True
    picPlayer.Visible = False
    
    ' Initialize the maze.
    LoadMaze
End Sub

' Draw the maze.
Private Sub DrawMaze()
Dim r As Integer
Dim c As Integer
Dim clr As Long

    ' Start from scratch.
    Cls
    
    For r = 1 To NumRows
        For c = 1 To NumCols
            If LegalMove(r, c) Then
                If r = RFinish And c = CFinish Then
                    clr = vbYellow
                Else
                    clr = vbWhite
                End If
            Else
                clr = RGB(128, 128, 128)
            End If
            Line (c * SQUARE_WID, r * SQUARE_HGT)-Step(-SQUARE_WID, -SQUARE_HGT), clr, BF
        Next c
    Next r
End Sub


' Initialize the maze.
Private Sub LoadMaze()
Dim fnum As Integer
Dim r As Integer
Dim c As Integer
Dim ch As String
Dim row_info As String

    ' Open the maze file.
    fnum = FreeFile
    Open App.Path & "\maze.dat" For Input As #fnum

    ' Read the number of rows and columns.
    Input #fnum, NumRows, NumCols
    ReDim LegalMove(1 To NumRows, 1 To NumCols)
    
    ' Read the data.
    For r = 1 To NumRows
        Line Input #fnum, row_info
        For c = 1 To NumCols
            ch = Mid$(row_info, c, 1)
            LegalMove(r, c) = (ch <> "#")
            If LCase$(ch) = "s" Then
                ' It's the start.
                PlayerR = r
                PlayerC = c
            ElseIf LCase$(ch) = "f" Then
                ' It's the finish.
                RFinish = r
                CFinish = c
            End If
        Next c
    Next r

    ' Close the file.
    Close #fnum

    ' Size the form.
    Width = ScaleX(SQUARE_WID * NumCols, ScaleMode, vbTwips) + _
        Width - ScaleX(ScaleWidth, ScaleMode, vbTwips)
    Height = ScaleY(SQUARE_HGT * NumRows, ScaleMode, vbTwips) + _
        Height - ScaleY(ScaleHeight, ScaleMode, vbTwips)

    ' Draw the maze.
    DrawMaze

    ' Position the player.
    PositionPlayer PlayerR, PlayerC

    ' Save the start time.
    StartTime = Timer
End Sub

' Draw the player.
Private Sub PositionPlayer(r As Integer, c As Integer)
Dim x As Single
Dim y As Single

    ' Erase the player's old position.
    If PlayerR > 0 Then
        x = (PlayerC - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
        y = (PlayerR - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
        Line (x - 1, y - 1)-Step(picPlayer.Width, picPlayer.Height), vbWhite, BF
    End If

    ' Move the player.
    PlayerR = r
    PlayerC = c

    ' Draw the player.
    x = (c - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
    y = (r - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
    PaintPicture picPlayer.Picture, x, y

    ' See if the player reached the finish.
    If r = RFinish And c = CFinish Then
        If MsgBox("You finished in " & _
            Int(Timer - StartTime) & " seconds." & _
            vbCrLf & "Play again?", vbYesNo, _
            "Congratulations") = vbYes _
        Then
            Form_Load
        Else
            Unload Me
        End If
    End If
End Sub