mdlmain.bas

游戏《家园》源码

Attribute VB_Name = "mdlMain"
Option Explicit

Public Declare Function misSetFile Lib "mission.dll" (ByVal szFile As String, ByVal nMode As Long) As Long

Public Declare Function misGetVal Lib "mission.dll" (ByVal szSection As String, ByVal szKey As String, szVal As String, ByVal nMode As Long) As Long
Public Declare Function misGetListByKey Lib "mission.dll" (ByVal szSection As String, ByVal szPrefix As String, szList As String, nCount As Integer, ByVal nMode As Long) As Long
Public Declare Function misGetListBySection Lib "mission.dll" (ByVal szPrefix As String, ByVal szKey As String, szList As String, nCount As Integer, ByVal nMode As Long) As Long

Public Declare Function misPutVal Lib "mission.dll" (ByVal szSection As String, ByVal szKey As String, ByVal szVal As String, ByVal nMode As Long) As Long
Public Declare Function misPutListByKey Lib "mission.dll" (ByVal szSection As String, ByVal szPrefix As String, ByVal szList As String, ByVal nMode As Long) As Long

Public Declare Function misOpen Lib "mission.dll" (pStream As Long, ByVal szFile As String) As Long
Public Declare Function misWriteAttrib Lib "mission.dll" (ByVal pStream As Long, ByVal szName As String, ByVal szVal As String) As Long
Public Declare Function misWriteInfo Lib "mission.dll" (ByVal pStream As Long, ByVal szInfo As String) As Long
Public Declare Function misWriteNew Lib "mission.dll" (ByVal pStream As Long) As Long
Public Declare Function misWriteVal Lib "mission.dll" (ByVal pStream As Long, ByVal szFormat As String, ByVal szVal As String) As Long
Public Declare Function misClose Lib "mission.dll" (ByVal pStream As Long) As Long

Public Declare Function misShellExec Lib "mission.dll" (ByVal szFile As String) As Long

Public Declare Function misGetHash Lib "mission.dll" (ByVal szText As String) As Long
Public Declare Function misGetVer Lib "mission.dll" (szVer As String) As Long
Public Declare Function misGetErr Lib "mission.dll" (ByVal nErr As Long, szMsg As String) As Long

Public Declare Function rendInit Lib "mission.dll" () As Long
Public Declare Function rendClean Lib "mission.dll" () As Long

Public Declare Function rendAngCheck Lib "mission.dll" (X As Single, Y As Single, Z As Single) As Long
Public Declare Function rendAngConv Lib "mission.dll" (fAngH As Single, fAngV As Single, ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Long

Public Declare Function rendNewObj Lib "mission.dll" (pObj As Long, ByVal nKey As Long, ByVal szUID As String) As Long
Public Declare Function rendFindObj Lib "mission.dll" (pObj As Long, ByVal nKey As Long) As Long
Public Declare Function rendDelObj Lib "mission.dll" (ByVal pObj As Long) As Long
Public Declare Function rendResetObj Lib "mission.dll" (ByVal pObj As Long) As Long
Public Declare Function rendSetObjLink Lib "mission.dll" (ByVal pObj As Long, ByVal pLink As Long) As Long
Public Declare Function rendGetObjTrans Lib "mission.dll" (ByVal pObj As Long, X As Single, Y As Single, Z As Single) As Long
Public Declare Function rendGetObjSize Lib "mission.dll" (ByVal pObj As Long, X As Single, Y As Single, Z As Single) As Long
Public Declare Function rendGetObjScale Lib "mission.dll" (ByVal pObj As Long, X As Single, Y As Single, Z As Single) As Long
Public Declare Function rendGetObjRot Lib "mission.dll" (ByVal pObj As Long, X As Single, Y As Single, Z As Single) As Long
Public Declare Function rendTransObj Lib "mission.dll" (ByVal pObj As Long, ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Long
Public Declare Function rendScaleObj Lib "mission.dll" (ByVal pObj As Long, ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Long
Public Declare Function rendRotObj Lib "mission.dll" (ByVal pObj As Long, ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Long
Public Declare Function rendGetObjMode Lib "mission.dll" (ByVal pObj As Long, nMode As Long) As Long
Public Declare Function rendSetObjMode Lib "mission.dll" (ByVal pObj As Long, ByVal nMode As Long) As Long
Public Declare Function rendSetObjCol Lib "mission.dll" (ByVal pObj As Long, ByVal nCol As Long) As Long

Public Declare Function rendNewCont Lib "mission.dll" (pContext As Long, ByVal hWnd As Long, ByVal nMode As Long) As Long
Public Declare Function rendDelCont Lib "mission.dll" (ByVal pContext As Long) As Long
Public Declare Function rendSetContDetail Lib "mission.dll" (ByVal pContext As Long, ByVal nDetail As Long) As Long
Public Declare Function rendSetContView Lib "mission.dll" (ByVal pContext As Long, ByVal X As Single, ByVal Y As Single, ByVal w As Single, ByVal h As Single) As Long
Public Declare Function rendSetContScale Lib "mission.dll" (ByVal pContext As Long, ByVal fViewScale As Single) As Long
Public Declare Function rendSetContBand Lib "mission.dll" (ByVal pContext As Long, aPos As Single, ByVal nCol As Long) As Long
Public Declare Function rendSetContGrid Lib "mission.dll" (ByVal pContext As Long, ByVal fSize As Single, ByVal nCol As Long) As Long
Public Declare Function rendSetContRot Lib "mission.dll" (ByVal pContext As Long, ByVal pObj As Long, ByVal nCol As Long) As Long
Public Declare Function rendSetContCursor Lib "mission.dll" (ByVal pContext As Long, aCursor As Single, ByVal nCol As Long) As Long
Public Declare Function rendSetContSel Lib "mission.dll" (ByVal pContext As Long, ByVal nCol As Long) As Long
Public Declare Function rendCheckContSel Lib "mission.dll" (ByVal pContext As Long, ByVal nMode As Long, nKey As Long) As Long
Public Declare Function rendCheckContCamera Lib "mission.dll" (ByVal pContext As Long, ByVal X As Single, ByVal Y As Single, nSel As Long) As Long
Public Declare Function rendGetContCamera Lib "mission.dll" (ByVal pContext As Long, aEye As Single, aFocus As Single) As Long
Public Declare Function rendSetContCamera Lib "mission.dll" (ByVal pContext As Long, aEye As Single, aFocus As Single, ByVal nCol As Long) As Long
Public Declare Function rendTransContCamera Lib "mission.dll" (ByVal pContext As Long, ByVal X As Single, ByVal Y As Single) As Long
Public Declare Function rendScaleContCamera Lib "mission.dll" (ByVal pContext As Long, ByVal fViewScale As Single) As Long
Public Declare Function rendRotContCamera Lib "mission.dll" (ByVal pContext As Long, ByVal fAngH As Single, ByVal fAngV As Single) As Long

Public Declare Function rendUpdateCont Lib "mission.dll" (ByVal pContext As Long) As Long
Public Declare Function rendResizeCont Lib "mission.dll" (ByVal pContext As Long) As Long
Public Declare Function rendPaintCont Lib "mission.dll" (ByVal pContext As Long) As Long

Public Declare Function rendGetSel Lib "mission.dll" (ByVal szPrefix As String, nCount As Integer, szKeys As String) As Long
Public Declare Function rendSetSel Lib "mission.dll" (ByVal szPrefix As String, ByVal szKeys As String) As Long
Public Declare Function rendTransSel Lib "mission.dll" (ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Long
Public Declare Function rendScaleSel Lib "mission.dll" (ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Long
Public Declare Function rendRotSel Lib "mission.dll" (ByVal pContext As Long, ByVal X As Single, ByVal Y As Single, ByVal Z As Single) As Long

'General constants
Public Const MIS_VER_NUM = "1.13B"
Public Const MIS_ENV_VAR = "HW_"
Public Const MIS_REF_ID = "MMAN"
Public Const MIS_MRU_COUNT = 5

'Directory constants
Public Const MIS_DIR_WORK = "$HW_Data\Multiplayer"
Public Const MIS_DIR_DATA = ""
Public Const MIS_DIR_OBJ = "~\Objects"

'File constants
Public Const MIS_FILE_INI = "mission.ini"
Public Const MIS_FILE_CFG = "mission.cfg"
Public Const MIS_FILE_HLP = "mission.doc"
Public Const MIS_FILE_DEF = "mission.mdr"

'Extension constants
Public Const MIS_EXT_DB = ".md?"
Public Const MIS_EXT_OBJ = ".mor"

'Mode constants
Public Const MIS_MOD_INI = 0
Public Const MIS_MOD_CFG = 1
Public Const MIS_MOD_REG = 2

'Bit mask
Public Const MIS_BIT_DEV = 1

'Section constants
Public Const MIS_SEC_SING = "S_"
Public Const MIS_SEC_MULTI = "M_"
Public Const MIS_SEC_LEV = "Level"
Public Const MIS_SEC_OBJ = "Object_"

Public Const MIS_SEC_COM = "Common"
Public Const MIS_SEC_GRAPH = "Graphics"

'Key constants
Public Const MIS_KEY_TYPE = "Type"
Public Const MIS_KEY_EXT = "Ext"
Public Const MIS_KEY_NAME = "Name_"
Public Const MIS_KEY_FILE = "File_"
Public Const MIS_KEY_VAR = "Var_"
Public Const MIS_KEY_FORM = "Format_"
Public Const MIS_KEY_REF = "Reference"
Public Const MIS_KEY_LINK = "Link"
Public Const MIS_KEY_ATTRIB = "Attrib_"
Public Const MIS_KEY_DEF = "Def_"
Public Const MIS_KEY_CONST = "Const_"
Public Const MIS_KEY_ALIAS = "Alias_"

Public Const MIS_KEY_VER = "Version"
Public Const MIS_KEY_REGK = "Reg_Key"
Public Const MIS_KEY_BITM = "Bit_Mask"
Public Const MIS_KEY_MRU = "Recent_File_"

Public Const MIS_KEY_TOOLB = "Tool_Bar"
Public Const MIS_KEY_STATB = "Status_Bar"

Public Const MIS_KEY_WORKD = "Work_Dir"
Public Const MIS_KEY_DATAD = "Data_Dir"
Public Const MIS_KEY_OBJD = "Object_Dir"

Public Const MIS_KEY_TREEV = "Tree_View_"
Public Const MIS_KEY_CAMV = "Cam_View_"
Public Const MIS_KEY_FRONTV = "Front_View_"
Public Const MIS_KEY_TOPV = "Top_View_"
Public Const MIS_KEY_SIDEV = "Side_View_"
Public Const MIS_KEY_LISTV = "List_View_"

Public Const MIS_KEY_MIST = "Mis_Table_"
Public Const MIS_KEY_LEVT = "Lev_Table_"
Public Const MIS_KEY_OBJT = "Obj_Table_"
Public Const MIS_KEY_ATTRIBT = "Attrib_Table_"
Public Const MIS_KEY_LAYERT = "Layer_Table_"

Public Const MIS_KEY_VOFFSET = "View_Offset_"
Public Const MIS_KEY_VSCALE = "View_Scale"
Public Const MIS_KEY_VCOL = "View_Color"

Public Const MIS_KEY_CINDEP = "Cam_Indep"
Public Const MIS_KEY_CEYE = "Cam_Eye_"
Public Const MIS_KEY_CFOCUS = "Cam_Focus_"
Public Const MIS_KEY_CSCALE = "Cam_Scale"
Public Const MIS_KEY_CMCOL = "Cam_Color"

Public Const MIS_KEY_GSNAP = "Grid_Snap"
Public Const MIS_KEY_GSIZE = "Grid_Size"
Public Const MIS_KEY_GCOL = "Grid_Color"

Public Const MIS_KEY_RSNAP = "Rot_Snap"
Public Const MIS_KEY_RANG = "Rot_Angle"
Public Const MIS_KEY_RCOL = "Rot_Color"

Public Const MIS_KEY_SINDEP = "Scale_Indep"

Public Const MIS_KEY_BCOL = "Band_Color"
Public Const MIS_KEY_SCOL = "Sel_Color"
Public Const MIS_KEY_CSCOL = "Curs_Color"

'Name constants
Public Const MIS_NAM_MIS = "New Mission"
Public Const MIS_NAM_LEV = "New Level"
Public Const MIS_NAM_OBJ = "New Object"
Public Const MIS_NAM_ATTRIB = "New Attribute"
Public Const MIS_NAM_NULL = "?"

'Flag constants
Public Const MIS_FLAG_TOOL = 1
Public Const MIS_FLAG_STAT = 1

'Camera constants
Public Const MIS_CAM_INDEP = 0
Public Const MIS_CAM_EX = -100000
Public Const MIS_CAM_EY = 0
Public Const MIS_CAM_EZ = 0
Public Const MIS_CAM_FX = 0
Public Const MIS_CAM_FY = 0
Public Const MIS_CAM_FZ = 0
Public Const MIS_CAM_SCALE = 1000
Public Const MIS_CAM_COL = vbWhite

'Renderer constants
Public Const MIS_REND_VOX = 0
Public Const MIS_REND_VOY = 0
Public Const MIS_REND_VOZ = 0
Public Const MIS_REND_VSCALE = 1000
Public Const MIS_REND_VCOL = vbWhite

Public Const MIS_REND_GSNAP = 1
Public Const MIS_REND_GSIZE = 1000
Public Const MIS_REND_GCOL = vbWhite

Public Const MIS_REND_RSNAP = 1
Public Const MIS_REND_RANG = 10
Public Const MIS_REND_RCOL = vbWhite

Public Const MIS_REND_SINDEP = 0

Public Const MIS_REND_BCOL = vbWhite
Public Const MIS_REND_SCOL = vbRed
Public Const MIS_REND_CCOL = vbGreen

'Attributes
Dim nDBAttribs As Integer

'Workspaces
Dim wspCurrent As Workspace

'Databases
Dim dbMission As Database
Dim dbClipboard As Database

'Query definitions
Dim qdfMission As QueryDef
Dim qdfClipboard As QueryDef

'Keys
Public sParKey As String
Public sCurKey As String
Public sCopyKey As String
Public sListKey As String

'Directories
Public sWorkDir As String
Public sDataDir As String
Public sObjDir As String
Public sWDir As String
Public sODir As String
Public sDDir As String

'Files
Public sDBFile As String
Public sCopyFile As String

'Info
Public sUndoInfo As String

'Flags
Public bFocusFlag As Boolean
Public bUndoFlag As Boolean
Public bDBFlag As Boolean
Public bDelFlag As Boolean
Public bOptFlag As Boolean
Public bToolFlag As Integer
Public bStatFlag As Integer
Public bCamFlag As Integer
Public bGridFlag As Integer
Public bRotFlag As Integer
Public bScaleFlag As Integer

'Colors
Public nViewCol As Long
Public nCamCol As Long
Public nGridCol As Long
Public nRotCol As Long
Public nBandCol As Long
Public nSelCol As Long
Public nCursCol As Long

'MRU list
Public nMRUCount As Integer
Public nMRUIndex As Integer

'Scales
Public fConvScale As Single
Public fViewScale As Single

'Sizes
Public fGridSize As Single
Public fRotAngle As Single

'Camera
Public aEye(3) As Single
Public aFocus(3) As Single

'Offset
Public aOffset(3) As Single
Public aCursor(3) As Single
Public aMouse(3) As Single

'Forms
Public fMainForm As frmMain

'Database recordsets
Public rsAttribs As Recordset
Public rsLayers As Recordset
Public rsLevels As Recordset
Public rsMission As Recordset
Public rsObjects As Recordset

Sub Main()
    Dim nAttribs As Integer

    Dim sPath As String
    Dim sFile As String

    'Get Path
    sPath = App.Path
    If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath + "\"
    
    'Check and change attribs
    sFile = sPath + MIS_FILE_INI
    nAttribs = GetAttr(sFile)
    If (nAttribs And vbReadOnly) <> 0 Then Call SetAttr(sFile, nAttribs And (Not vbReadOnly))

    'Set INI file
    Call misSetFile(sFile, MIS_MOD_INI)
    
    'Set config file
    sFile = sPath + MIS_FILE_CFG
    Call misSetFile(sFile, MIS_MOD_CFG)
    
    'Create MDI form
    Set fMainForm = New frmMain
    
    'Reset files
    sDBFile = ""
    sCopyFile = ""
    
    'Reset dirs
    sWorkDir = ""
    sObjDir = ""
    sDataDir = ""
    
    'Reset keys
    sParKey = ""
    sCurKey = ""
    sCopyKey = ""
    sListKey = ""
    
    'Reset flags
    bFocusFlag = True
    bUndoFlag = False
    bDBFlag = False
    bDelFlag = False
    bOptFlag = False
    
    'Reset cursor
    aCursor(0) = 0
    aCursor(1) = 0
    aCursor(2) = 0
    
    'Get conversion scale
    fConvScale = (Screen.TwipsPerPixelX + Screen.TwipsPerPixelY) / 2
    
    'Initialize renderer
    rendInit
        
    'Get options
    frmOptions.GetOptions
        
    'Show MDI form
    fMainForm.Show
End Sub

Sub AntiMain()
    'Put MRU list
    fMainForm.PutMRUList
        
    'Check options flag
    If bOptFlag = True Then
        'Prompt user
        If MsgBox("Save options?", vbYesNo Or vbQuestion, "MissionMan") = vbYes Then frmOptions.PutOptions
    End If
    
    'Prompt user
    If MsgBox("Exit MissionMan?", vbYesNo Or vbQuestion, "MissionMan") = vbNo Then Exit Sub
    
    'Hide views
    Unload frmCamera
    Unload frmSide
    Unload frmTop
    Unload frmFront
    Unload frmTree
    
    'Hide other views
    Unload frmList
    Unload frmLayers
    Unload frmMission
    Unload frmLevels
    Unload frmObjects
    Unload frmAttribs
    
    'Cleanup renderer
    rendClean
    
    'Close databases
    CloseDB
            
    'End program
    End
End Sub

Sub OpenDB()
    'Close database
    CloseDB
    
    'Get attributes
    nDBAttribs = GetAttr(sDBFile)
    
    'Check attrib
    If (nDBAttribs And vbReadOnly) <> 0 Then
        'Inform user
        If MsgBox("File " + sDBFile + " is read-only. Open mission database anyway?", vbYesNo Or vbQuestion, "MissionMan") = vbNo Then Exit Sub
        
        'Change attributes
        Call SetAttr(sDBFile, nDBAttribs And (Not vbReadOnly))
    End If

    'Set error handler for database
    On Error GoTo DBErr
      
    'Clear flags
    bUndoFlag = False
    
    'Open mission database
    Set wspCurrent = DBEngine.Workspaces(0)
    Set dbMission = wspCurrent.OpenDatabase(sDBFile)
    
    'Set error handler for recordsets
    On Error GoTo RSErr
    
    'Open record sets
    Set rsAttribs = dbMission.OpenRecordset("Attrib")
    Set rsLayers = dbMission.OpenRecordset("Layers")
    Set rsLevels = dbMission.OpenRecordset("Levels")
    Set rsMission = dbMission.OpenRecordset("Mission")
    Set rsObjects = dbMission.OpenRecordset("Objects")
    
    'Create temporary query definition
    Set qdfMission = dbMission.CreateQueryDef("")
    
    'Memorize changes
    wspCurrent.BeginTrans
    
    'Set database flag
    bDBFlag = True
    Exit Sub
    
    'Error handler for database
DBErr:
    'Inform user
    Call MsgBox("Error: Unable to open mission database (Check file " + sDBFile + ")!", vbOKOnly Or vbExclamation, "MissionMan")
    Exit Sub
    
    'Error handler for recordsets
RSErr:
    'Inform user
    Call MsgBox("Error: Invalid mission database (Check tables)!", vbOKOnly Or vbExclamation, "MissionMan")
    Exit Sub
End Sub

Sub CloseDB()
    'Check database flag
    If bDBFlag = True Then
        'Commit change
        wspCurrent.CommitTrans
    
        'Close recordsets
        rsAttribs.Close
        rsLayers.Close
        rsLevels.Close
        rsMission.Close
        rsObjects.Close
        
        'Close query definitions
        qdfMission.Close
        
        'Close database
        dbMission.Close