frmnpc.frm

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

VERSION 5.00
Begin VB.Form frmNPC 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "NPC Data"
   ClientHeight    =   6120
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   2775
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   6120
   ScaleWidth      =   2775
   Begin VB.TextBox txtMonster 
      Height          =   285
      Left            =   840
      TabIndex        =   22
      Top             =   4440
      Width           =   1695
   End
   Begin VB.CheckBox chkDisappear 
      Caption         =   "Disappear after speech?"
      Height          =   255
      Left            =   120
      TabIndex        =   21
      Top             =   5760
      Width           =   2535
   End
   Begin VB.CheckBox chkVisible 
      Caption         =   "Visible"
      Height          =   255
      Left            =   120
      TabIndex        =   20
      Top             =   5520
      Width           =   1455
   End
   Begin VB.TextBox txtYCoord 
      Height          =   285
      Left            =   840
      TabIndex        =   19
      Top             =   5160
      Width           =   1695
   End
   Begin VB.TextBox txtXCoord 
      Height          =   285
      Left            =   840
      TabIndex        =   17
      Top             =   4920
      Width           =   1695
   End
   Begin VB.TextBox txtCharNum 
      Height          =   285
      Left            =   840
      TabIndex        =   15
      Top             =   4200
      Width           =   1695
   End
   Begin VB.TextBox txtBehaviour 
      Height          =   285
      Left            =   840
      TabIndex        =   13
      Top             =   3960
      Width           =   1695
   End
   Begin VB.TextBox txtProgress 
      Height          =   285
      Left            =   840
      TabIndex        =   11
      Top             =   3720
      Width           =   1695
   End
   Begin VB.TextBox txtItem 
      Height          =   285
      Left            =   840
      TabIndex        =   9
      Top             =   3480
      Width           =   1695
   End
   Begin VB.TextBox txtSpeech 
      Height          =   1215
      Left            =   840
      MultiLine       =   -1  'True
      TabIndex        =   7
      Top             =   2280
      Width           =   1695
   End
   Begin VB.ListBox lstBehaviour 
      Height          =   450
      Left            =   120
      TabIndex        =   5
      Top             =   1680
      Width           =   2535
   End
   Begin VB.CommandButton cmdClearBehaviour 
      Caption         =   "Clear all Bhvrs"
      Height          =   375
      Left            =   1440
      TabIndex        =   4
      Top             =   1200
      Width           =   1215
   End
   Begin VB.CommandButton cmdAddBehaviou 
      Caption         =   "Add Behaviour"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   1200
      Width           =   1215
   End
   Begin VB.ListBox lstNPC 
      Height          =   450
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   2535
   End
   Begin VB.CommandButton cmdClearNPCs 
      Caption         =   "Clear all NPCs"
      Height          =   375
      Left            =   1440
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.CommandButton cmdAddNPC 
      Caption         =   "Add NPC"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label8 
      Caption         =   "Monster:"
      Height          =   255
      Left            =   120
      TabIndex        =   23
      Top             =   4515
      Width           =   735
   End
   Begin VB.Label Label7 
      Caption         =   "Y Coord:"
      Height          =   255
      Left            =   120
      TabIndex        =   18
      Top             =   5235
      Width           =   735
   End
   Begin VB.Label Label6 
      Caption         =   "X Coord:"
      Height          =   255
      Left            =   120
      TabIndex        =   16
      Top             =   4995
      Width           =   735
   End
   Begin VB.Label Label5 
      Caption         =   "Char num:"
      Height          =   255
      Left            =   120
      TabIndex        =   14
      Top             =   4275
      Width           =   735
   End
   Begin VB.Label Label4 
      Caption         =   "Behaviour"
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   4035
      Width           =   735
   End
   Begin VB.Label Label3 
      Caption         =   "Progress:"
      Height          =   255
      Left            =   120
      TabIndex        =   10
      Top             =   3795
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "Item:"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   3560
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "Speech:"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   2280
      Width           =   615
   End
End
Attribute VB_Name = "frmNPC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mintCurrentNPC As Integer   'Which NPC is currently being edited?
Dim mintCurrentBehaviour As Integer     'Which behaviour is currently being edited?

Private Sub chkDisappear_Click()

    If chkDisappear.Value = vbChecked Then
        gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).blnDisapear = True
    Else
        gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).blnDisapear = False
    End If

End Sub

Private Sub chkVisible_Click()

    If chkVisible.Value = vbChecked Then
        gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).blnVisible = True
    Else
        gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).blnVisible = False
    End If

End Sub

Private Sub cmdAddBehaviou_Click()

Dim lngProgress As Long

    'Handle errors..
    On Local Error GoTo ErrOut

    'Ask for the progress value required for this behaviour to be displayed
    lngProgress = InputBox("Progress value?", "Progress")
    
    'Create a new behaviour
    ReDim Preserve gudtNPC(mintCurrentNPC).udtBehaviour(UBound(gudtNPC(mintCurrentNPC).udtBehaviour) + 1)
    
    'Assign the progress requirement
    gudtNPC(mintCurrentNPC).udtBehaviour(UBound(gudtNPC(mintCurrentNPC).udtBehaviour)).lngProgressReq = lngProgress
    
    'Refresh the list
    RefreshBehaviourList
    
    'Select the newest behaviour
    lstBehaviour.ListIndex = lstBehaviour.ListCount - 1
    
    'Exit before error code
    Exit Sub
    
ErrOut:
    MsgBox "Invalid input.", vbOKOnly, "Error"

End Sub

Private Sub cmdAddNPC_Click()

    'Add another NPC
    ReDim Preserve gudtNPC(UBound(gudtNPC) + 1)
    ReDim gudtNPC(UBound(gudtNPC)).udtBehaviour(0)
    RefreshNPCList
    
    'Select appriorately
    lstNPC.ListIndex = lstNPC.ListCount - 1
    lstBehaviour.ListIndex = 0

End Sub

Private Sub cmdClearBehaviour_Click()

    'Remove every behaviour
    ReDim gudtNPC(mintCurrentNPC).udtBehaviour(0)
    mintCurrentBehaviour = 0
    RefreshBehaviourList
    lstBehaviour.ListIndex = 0

End Sub

Private Sub cmdClearNPCs_Click()

    'Remove every NPC and behaviour set
    ReDim gudtNPC(0)
    ReDim gudtNPC(0).udtBehaviour(0)
    mintCurrentNPC = 0
    mintCurrentBehaviour = 0
    RefreshNPCList
    RefreshBehaviourList
    lstNPC.ListIndex = 0
    lstBehaviour.ListIndex = 0

End Sub

Private Sub Form_Load()

    'Set up the listboxes and current selections
    mintCurrentNPC = 0
    mintCurrentBehaviour = 0
    RefreshNPCList
    RefreshBehaviourList
    lstNPC.ListIndex = 0
    lstBehaviour.ListIndex = 0
    RefreshData

End Sub

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

End Sub

Private Sub RefreshNPCList()

Dim i As Integer

    'Refresh the NPC list box
    lstNPC.Clear
    For i = 0 To UBound(gudtNPC)
        lstNPC.AddItem i
    Next i

End Sub

Private Sub RefreshBehaviourList()

Dim i As Integer

    'Refresh the NPC list box
    lstBehaviour.Clear
    For i = 0 To UBound(gudtNPC(mintCurrentNPC).udtBehaviour)
        lstBehaviour.AddItem gudtNPC(mintCurrentNPC).udtBehaviour(i).lngProgressReq
    Next i

End Sub

Private Sub RefreshData()

    'Refresh all fields based on current NPC and Behaviour selection
    txtSpeech.Text = gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).strText
    txtItem.Text = gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).bytTalkItemChange
    txtProgress.Text = gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).lngTalkProgChange
    txtBehaviour.Text = gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).bytBehaviour
    txtCharNum.Text = gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).bytCharNum
    txtMonster.Text = gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).bytMonster
    txtXCoord.Text = gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).intX
    txtYCoord.Text = gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).intY
    If gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).blnVisible = True Then
        chkVisible.Value = vbChecked
    Else
        chkVisible.Value = vbUnchecked
    End If
    If gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).blnDisapear = True Then
        chkDisappear.Value = vbChecked
    Else
        chkDisappear.Value = vbUnchecked
    End If

End Sub

Private Sub lstBehaviour_Click()

    'Change the current behaviour and refresh data
    mintCurrentBehaviour = lstBehaviour.ListIndex
    RefreshData

End Sub

Private Sub lstNPC_Click()

    'Change the current NPC and refresh data
    mintCurrentNPC = lstNPC.ListIndex
    RefreshBehaviourList
    mintCurrentBehaviour = 0
    lstBehaviour.ListIndex = 0
    RefreshData

End Sub

Private Sub txtBehaviour_LostFocus()

    On Local Error Resume Next

    gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).bytBehaviour = txtBehaviour.Text

End Sub

Private Sub txtCharNum_LostFocus()

    On Local Error Resume Next

    gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).bytCharNum = txtCharNum.Text

End Sub

Private Sub txtItem_LostFocus()

    On Local Error Resume Next

    gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).bytTalkItemChange = txtItem.Text

End Sub

Private Sub txtMonster_LostFocus()

    On Local Error Resume Next

    gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).bytMonster = txtMonster.Text

End Sub

Private Sub txtProgress_LostFocus()

    On Local Error Resume Next

    gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).lngTalkProgChange = txtProgress.Text

End Sub

Private Sub txtSpeech_LostFocus()

    gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).strText = txtSpeech.Text

End Sub

Private Sub txtXCoord_LostFocus()

    On Local Error Resume Next

    gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).intX = txtXCoord.Text
    
End Sub

Private Sub txtYCoord_LostFocus()

    On Local Error Resume Next

    gudtNPC(mintCurrentNPC).udtBehaviour(mintCurrentBehaviour).intY = txtYCoord.Text
    
End Sub