frmmap.frm

VB编写的RPG游戏演示,适合VB游戏初学者的参考。

VERSION 5.00
Begin VB.Form frmMap 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Map"
   ClientHeight    =   6495
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7590
   ForeColor       =   &H000000FF&
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   433
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   506
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   18720
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   14640
      Width           =   255
   End
   Begin VB.HScrollBar scrHor 
      Height          =   255
      Left            =   0
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   6240
      Width           =   1095
   End
   Begin VB.VScrollBar scrVert 
      Height          =   1335
      Left            =   7320
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   0
      Width           =   255
   End
End
Attribute VB_Name = "frmMap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    'Handle keypresses..
    Select Case KeyCode
        'Let the "w" key toggle the walkability of current tile
        Case vbKeyW
            If gudtMap(gintMapX, gintMapY).blnNonWalkable = True Then
                gudtMap(gintMapX, gintMapY).blnNonWalkable = False
            Else
                gudtMap(gintMapX, gintMapY).blnNonWalkable = True
            End If
            'Update displayed info
            frmInfo.UpdateInfo
        'Let the enter key cause tile placement
        Case vbKeyReturn
            gudtMap(gintMapX, gintMapY).bytTileX = gintTileX
            gudtMap(gintMapX, gintMapY).bytTileY = gintTileY
            Form_Paint
        'Let the arrow keys move the selected tile
        Case vbKeyLeft
            If gintMapX > 0 Then gintMapX = gintMapX - 1
            frmInfo.UpdateInfo
            Form_Paint
        Case vbKeyRight
            If gintMapX < gintMapWidth Then gintMapX = gintMapX + 1
            frmInfo.UpdateInfo
            Form_Paint
        Case vbKeyDown
            If gintMapY < gintMapHeight Then gintMapY = gintMapY + 1
            frmInfo.UpdateInfo
            Form_Paint
        Case vbKeyUp
            If gintMapY > 0 Then gintMapY = gintMapY - 1
            frmInfo.UpdateInfo
            Form_Paint
    End Select

End Sub

Private Sub Form_Load()

    'Size the form
    Me.Width = 9950
    Me.Height = 7830

    'Resize the scrollbars!
    Form_Resize
    
    'Paint the form
    Form_Paint

End Sub

Private Sub Form_Paint()

Dim i As Integer
Dim j As Integer
    
    'Clear the screen
    Me.Cls

    'Redraw the tiles
    For i = 0 To (frmMap.ScaleWidth - scrVert.Width) \ TILE_WIDTH - 1
        For j = 0 To (frmMap.ScaleHeight - scrHor.Height) \ TILE_HEIGHT - 1
            StretchDIBits Me.hdc, i * TILE_WIDTH, j * TILE_HEIGHT, TILE_WIDTH, TILE_HEIGHT, gudtMap(i + scrHor.Value, j + scrVert.Value).bytTileX * TILE_WIDTH, gBMPInfo.bmiHeader.biHeight - gudtMap(i + scrHor.Value, j + scrVert.Value).bytTileY * TILE_HEIGHT - TILE_HEIGHT, TILE_WIDTH, TILE_HEIGHT, gBMPData(0), gBMPInfo, DIB_RGB_COLORS, vbSrcCopy
        Next j
    Next i

    'Redraw the box
    DrawBox

End Sub

Private Sub Form_Resize()

    'Resize the horizontal scrollbar
    scrHor.Left = 0
    scrHor.Top = frmMap.ScaleHeight - scrHor.Height
    scrHor.Width = frmMap.ScaleWidth - scrVert.Width
    
    'Resize the vertical scrollbar
    scrVert.Top = 0
    scrVert.Left = frmMap.ScaleWidth - scrVert.Width
    scrVert.Height = frmMap.ScaleHeight - scrHor.Height
    
    'Set the scrollbar values
    scrHor.Max = gintMapWidth - (frmMap.ScaleWidth - scrVert.Width) \ TILE_WIDTH
    scrVert.Max = gintMapHeight - (frmMap.ScaleHeight - scrHor.Height) \ TILE_HEIGHT
    
    'Repaint the form
    Form_Paint

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    'Change the active tile when form is clicked
    gintMapX = x \ TILE_WIDTH + scrHor.Value
    gintMapY = y \ TILE_HEIGHT + scrVert.Value
    frmInfo.UpdateInfo
        
    'If it's a right-click, assign a new tile
    If Button = vbRightButton Then
        gudtMap(gintMapX, gintMapY).bytTileX = gintTileX
        gudtMap(gintMapX, gintMapY).bytTileY = gintTileY
    End If
        
    'Repaint the form
    Form_Paint

End Sub

Private Sub DrawBox()

Dim intX As Integer
Dim intY As Integer
    
    'Draw a box
    intX = gintMapX * TILE_WIDTH - scrHor.Value * TILE_WIDTH
    intY = gintMapY * TILE_HEIGHT - scrVert.Value * TILE_HEIGHT
    MoveToEx Me.hdc, intX, intY, gudtPoint
    LineTo Me.hdc, intX + TILE_WIDTH, intY
    LineTo Me.hdc, intX + TILE_WIDTH, intY + TILE_HEIGHT
    LineTo Me.hdc, intX, intY + TILE_HEIGHT
    LineTo Me.hdc, intX, intY

End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    'Check for dirtiness before exiting
    Cancel = ExitProgram()

End Sub

Private Sub scrHor_Change()

    'Repaint the form
    Form_Paint

End Sub

Private Sub scrVert_Change()

    'Repaint the form
    Form_Paint

End Sub