frmmain.frm

一个游戏的原代码

 Case "Swim"
  MD3Model.SetLowerAni = LEGS_SWIM
 Case "Jump"
  MD3Model.SetLowerAni = LEGS_JUMP
 Case "Land"
  MD3Model.SetLowerAni = LEGS_LAND
 Case "Jump b"
  MD3Model.SetLowerAni = LEGS_JUMPB
 Case "Land b"
  MD3Model.SetLowerAni = LEGS_LANDB
 Case "Idle"
  MD3Model.SetLowerAni = LEGS_IDLE
 Case "Crouch-Idle"
  MD3Model.SetLowerAni = LEGS_IDLECR
 Case "Turn"
  MD3Model.SetLowerAni = LEGS_TURN
End Select
End Sub

Private Sub cmbUpper_Click()
Select Case cmbUpper.List(cmbUpper.ListIndex)
 Case "Gesture"
  MD3Model.SetUpperAni = TORSO_GESTURE
 Case "Attack 1"
  MD3Model.SetUpperAni = TORSO_ATTACK
 Case "Attack 2"
  MD3Model.SetUpperAni = TORSO_ATTACK2
 Case "Drop"
  MD3Model.SetUpperAni = TORSO_DROP
 Case "Raise"
  MD3Model.SetUpperAni = TORSO_RAISE
 Case "Stand 1"
  MD3Model.SetUpperAni = TORSO_STAND
 Case "Stand 2"
  MD3Model.SetUpperAni = TORSO_STAND2
End Select
End Sub

Private Sub Command1_Click()
Dim tmpPdata As MVB_PLAYERDATA
tmpPdata = player

cdlg.InitDir = App.path & "\textures\"
cdlg.DialogTitle = "Open Texture"
cdlg.Filter = "Texture-file (*.*)|*.*"
cdlg.ShowOpen
If FileExists(cdlg.FileName) Then
    CreateFloor MD2Model.BoxMin.y, cdlg.FileName
End If

modCam.Movement
player = tmpPdata
End Sub

Private Sub Command2_Click()
For i = 0 To 99
    If FileExists(App.path & "\screen" & i & ".bmp") = False Then
        ScreenShot App.path & "\screen" & i & ".bmp"
        Exit For
    End If
Next i
End Sub

Private Sub exit_Click()
lRunning = False
End Sub

Private Sub Form_Load()
cmbUpper.AddItem "Gesture"
cmbUpper.AddItem "Attack 1"
cmbUpper.AddItem "Attack 2"
cmbUpper.AddItem "Drop"
cmbUpper.AddItem "Raise"
cmbUpper.AddItem "Stand 1"
cmbUpper.AddItem "Stand 2"
cmbUpper.ListIndex = 5

cmbLower.AddItem "Crouch-Walk"
cmbLower.AddItem "Walk"
cmbLower.AddItem "Run"
cmbLower.AddItem "Back"
cmbLower.AddItem "Swim"
cmbLower.AddItem "Jump"
cmbLower.AddItem "Land"
cmbLower.AddItem "Jump b"
cmbLower.AddItem "Land b"
cmbLower.AddItem "Idle"
cmbLower.AddItem "Crouch-Idle"
cmbLower.AddItem "Turn"
cmbLower.ListIndex = 9

CalculateVars
InitD3D
End Sub

Public Function InStrNum(InString As String) As Long
Dim ix As Long
For ix = 1 To Len(InString)
  If IsNumeric(Mid$(InString, ix, 1)) Then InStrNum = ix: Exit For
Next ix
End Function

Public Sub CreateFrameList()
Dim lastFrameName As String

If MD2Model.Loaded Then
    List1.Clear
    For i = 0 To MD2Model.NumFrames
        If InStrNum(MD2Model.GetFrameName(i)) <> 0 Then
            If Not lastFrameName = Mid(MD2Model.GetFrameName(i), 1, InStrNum(MD2Model.GetFrameName(i)) - 1) Then
                lastFrameName = Mid(MD2Model.GetFrameName(i), 1, InStrNum(MD2Model.GetFrameName(i)) - 1)
                List1.AddItem Mid(MD2Model.GetFrameName(i), 1, InStrNum(MD2Model.GetFrameName(i)) - 1)
            End If
        End If
    Next i
    Check3.Value = 0
    Check2.Value = 1
    Check1.Value = 1
    List1.ListIndex = 0
    CreateFloor MD2Model.BoxMin.y
End If
MD2Model.MD2AnimSpeed = Slider1.Value

Dim light As D3DLIGHT8
With light
 .Type = D3DLIGHT_POINT
 .Ambient = CreateD3DColorVal(1, 1, 1, 1)
 .diffuse = CreateD3DColorVal(1, 1, 1, 1)
 .specular = CreateD3DColorVal(1, 1, 1, 1)
 .Position = MakeVector(0, MD2Model.BoxMax.y + 5, 0)
 .Attenuation0 = 0
 .Attenuation1 = 0.1
 .Attenuation2 = 0
 .Range = 64
End With
D3Ddevice.SetLight 0, light
D3Ddevice.LightEnable 0, True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
lRunning = False
Cancel = 1
End Sub

Private Sub hp_Click()
Shell "explorer http:'www.matrixvb.da.ru/"
End Sub

Private Sub lanim_Click()
MD2Model.AnimType = 0
MD2Weapon.AnimType = 0
End Sub

Private Sub List1_Click()
If Check1.Value = 1 Then
MD2Model.FramePrefix = List1.Text
MD2Weapon.FramePrefix = List1.Text
Else
MD2Model.FramePrefix = List1.Text
MD2Weapon.FramePrefix = List1.Text
End If
End Sub

Private Sub mnuGouraud_Click()
If mnuGouraud.Checked = False Then
    D3Ddevice.SetRenderState D3DRS_SHADEMODE, D3DSHADE_GOURAUD
    mnuGouraud.Checked = True
Else
    D3Ddevice.SetRenderState D3DRS_SHADEMODE, D3DSHADE_FLAT
    mnuGouraud.Checked = False
End If
End Sub

Private Sub mnuLoadMD2Player_Click()
Dim ModelPath As String, ModelTexPath As String
Dim tmpPdata As MVB_PLAYERDATA
tmpPdata = player

'Open MD2
cdlg.InitDir = App.path
cdlg.DialogTitle = "Open QuakeII MD2-file (model)"
cdlg.Filter = "QuakeII-model (*.md2)|*.md2"
cdlg.ShowOpen
ModelPath = cdlg.FileName
'Open Texture
cdlg.InitDir = cdlg.FileName
cdlg.FileName = vbNullString
cdlg.DialogTitle = "Open Texture-file"
cdlg.Filter = "Texture-file (*.bmp,*.jpg,*.jpeg,*.png,*.tga)|*.bmp;*.jpg;*.jpeg;*.png;*.tga;*.pcx"
cdlg.ShowOpen
ModelTexPath = cdlg.FileName

If FileExists(ModelPath) And FileExists(ModelTexPath) Then
    MD3Model.bLoaded = False
    frmMD3.Visible = False
    frmMD2.Visible = True
    MD2Model.LoadMD2 ModelPath
    MD2Model.LoadMD2Texture ModelTexPath
    lblMD2Verts.Caption = MD2Model.NumTriangles * 3
End If

If (Not MD2Weapon.NumFrames = MD2Model.NumFrames) And MD2Weapon.Loaded And MD2Model.Loaded Then
    MsgBox "The character- and weapon-models frame number is different! The weapon-model will not be displayed.", vbOKOnly, "Error"
    MD2Weapon.Loaded = False
End If

CreateFrameList
modCam.Movement
player = tmpPdata
End Sub

Private Sub mnuLoadMD2Weapon_Click()
Dim WeaponPath As String, WeaponTexPath As String
Dim tmpPdata As MVB_PLAYERDATA
tmpPdata = player

'Open weapon model
cdlg.DialogTitle = "Open QuakeII MD2-file (weapon)"
cdlg.Filter = "QuakeII-model (*.md2)|*.md2"
cdlg.ShowOpen
WeaponPath = cdlg.FileName
'Open weapon texture
cdlg.InitDir = cdlg.FileName
cdlg.FileName = vbNullString
cdlg.DialogTitle = "Open Weapon-Texture-File"
cdlg.Filter = "Texture-file (*.bmp,*.jpg,*.jpeg,*.png,*.tga)|*.bmp;*.jpg;*.jpeg;*.png;*.tga;*.pcx"
cdlg.ShowOpen
WeaponTexPath = cdlg.FileName

If FileExists(WeaponPath) And FileExists(WeaponTexPath) Then
    MD2Weapon.LoadMD2 WeaponPath
    MD2Weapon.LoadMD2Texture WeaponTexPath
    lblMD2WeaponVerts.Caption = MD2Weapon.NumTriangles * 3
End If

If (Not MD2Weapon.NumFrames = MD2Model.NumFrames) And MD2Weapon.Loaded And MD2Model.Loaded Then
    MsgBox "The character- and weapon-models frame number is different! The weapon-model will not be displayed.", vbOKOnly, "Error"
    MD2Weapon.Loaded = False
End If

modCam.Movement
player = tmpPdata
End Sub

Private Sub mnuLoadMD3Player_Click()
Dim ModelPath As String
Dim tmpPdata As MVB_PLAYERDATA
tmpPdata = player

'Open weapon model
cdlg.DialogTitle = "Open Quake3 MD3-file (player)"
cdlg.Filter = "Quake3-model (*.md3)|*.md3"
cdlg.ShowOpen
ModelPath = GetPathOnly(cdlg.FileName)

If FileExists(ModelPath) Then
    MD2Model.Loaded = False
    frmMD2.Visible = False
    frmMD3.Visible = True
    MD3Model.LoadMD3 ModelPath
    MD3Model.SetLowerAni = LEGS_IDLE
    MD3Model.SetUpperAni = TORSO_STAND
    
    'Render the model to find out the bounding box of the model when it stands still
    MD3Model.Render matWorld, True
    modFloor.CreateFloor MD3Model.BoxMin.y
    
    Dim light As D3DLIGHT8
    With light
    .Type = D3DLIGHT_POINT
    .Ambient = CreateD3DColorVal(1, 1, 1, 1)
    .diffuse = CreateD3DColorVal(1, 1, 1, 1)
    .specular = CreateD3DColorVal(1, 1, 1, 1)
    .Position = MakeVector(0, MD3Model.BoxMax.y + 5, 0)
    .Attenuation0 = 0
    .Attenuation1 = 0.1
    .Attenuation2 = 0
    .Range = 64
    End With
    D3Ddevice.SetLight 0, light
    D3Ddevice.LightEnable 0, True
    
End If

lblModelVerts.Caption = MD3Model.NumVertices

modCam.Movement
player = tmpPdata
End Sub

Private Sub mnuLoadMD3Weapon_Click()
Dim WeaponPath As String
Dim tmpPdata As MVB_PLAYERDATA
tmpPdata = player

'Open weapon model
cdlg.DialogTitle = "Open Quake3 MD3-file (weapon)"
cdlg.Filter = "Quake3-model (*.md3)|*.md3"
cdlg.ShowOpen
WeaponPath = cdlg.FileName

If FileExists(WeaponPath) Then
    MD3Model.LoadMD3Weapon WeaponPath
End If

lblWeaponVerts.Caption = MD3Model.NumWeaponVertices

modCam.Movement
player = tmpPdata
End Sub

Private Sub mnuTextured_Click()
If mnuTextured.Checked = False Then
    MD2Model.bUseTexture = True
    MD2Weapon.bUseTexture = True
    MD3Model.bUseTextures = True
    mnuTextured.Checked = True
Else
    MD2Model.bUseTexture = False
    MD2Weapon.bUseTexture = False
    MD3Model.bUseTextures = False
    mnuTextured.Checked = False
End If
End Sub

Private Sub mnuWireframe_Click()
If mnuWireframe.Checked = False Then
    D3Ddevice.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME
    mnuWireframe.Checked = True
Else
    D3Ddevice.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID
    mnuWireframe.Checked = False
End If
End Sub

Private Sub nanim_Click()
MD2Model.AnimType = 2
MD2Weapon.AnimType = 2
End Sub

Private Sub optMD3Linear_Click()
MD3Model.bLinearKeyFrames = True
End Sub

Private Sub optMD3NoKeyFrame_Click()
MD3Model.bLinearKeyFrames = False
End Sub

Private Sub Slider1_Click()
MD2Model.MD2AnimSpeed = Slider1.Value
End Sub

Private Sub Slider2_Click()
MD3Model.AnimSpeed = Slider2.Value / 1000
End Sub