frmlookup.frm

游戏《家园》源码

    'Loop thru frequency data
    For i = 0 To nVRCount - 1
        'Read frequency data
        nErr = volReadFreq(aFreq(0))
        If nErr < 0 Then
            'Reset mouse pointer
            MousePointer = vbDefault
                
            'Inform User
            Call volGetErr(nErr, sText)
            Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
                
            'Close frequency data
            Call volCloseRFreq
            
            'Error
            OpenFreq = False
            Exit Function
        End If
        
        'Loop thru level data
        For j = 0 To 7
            SldLev(j + (i * 8)).Value = -aFreq(j) * 100
        Next j
    Next i
    
    'Close frequency data
    nErr = volCloseRFreq()
    If nErr < 0 Then
        'Reset mouse pointer
        MousePointer = vbDefault
        
        'Inform User
        Call volGetErr(nErr, sText)
        Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
        
        'Error
        OpenFreq = False
        Exit Function
    End If
        
    'Reset mouse pointer
    MousePointer = vbDefault
End Function

Function SaveLookup(ByVal sFileName As String, ByVal sID As String, ByVal nOffset As Integer) As Boolean
    Dim i As Integer, j As Integer, k As Integer
    Dim nRow As Integer, nCol As Integer
    
    Dim nErr As Long
    
    Dim aLookup() As Long
    
    Dim sText As String
    
    'Default
    SaveLookup = True
    
    'Set mouse pointer
    MousePointer = vbHourglass
    
    'Dimension data array
    ReDim aLookup(nVRCount)
    
    'Open lookup table
    nErr = volOpenWLookup(sFileName, sID, nVRCount, nHeadCount)
    If nErr < 0 Then
        'Reset mouse pointer
        MousePointer = vbDefault
        
        'Inform User
        Call volGetErr(nErr, sText)
        Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
        
        'Error
        SaveLookup = False
        Exit Function
    End If

    'Get row and column
    nCol = FGLookup.Col
    nRow = FGLookup.Row
    
    'Loop thru lookup table
    For i = 0 To nHeadCount - 1
        'Set row
        FGLookup.Row = i + 1
    
        For j = 0 To nVRCount * 2 - 1
            'Set column
            FGLookup.Col = j + 1
            
            'Set data
            If j Mod 2 = nOffset Then aLookup((j - nOffset) / 2) = Val(FGLookup.Text)
        Next j
            
        'Write to lookup table
        nErr = volWriteLookup(aLookup(0))
        If nErr < 0 Then
            'Set row and column
            FGLookup.Col = nCol
            FGLookup.Row = nRow
            
            'Reset mouse pointer
            MousePointer = vbDefault
                
            'Inform User
            Call volGetErr(nErr, sText)
            Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
                
            'Close lookup table
            Call volCloseWLookup
            
            'Error
            SaveLookup = False
            Exit Function
        End If
    Next i
    
    'Close lookup table
    nErr = volCloseWLookup()
    If nErr < 0 Then
        'Set row and column
        FGLookup.Col = nCol
        FGLookup.Row = nRow
            
        'Reset mouse pointer
        MousePointer = vbDefault
        
        'Inform User
        Call volGetErr(nErr, sText)
        Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
        
        'Error
        SaveLookup = False
        Exit Function
    End If
    
    'Set row and column
    FGLookup.Col = nCol
    FGLookup.Row = nRow
        
    'Reset mouse pointer
    MousePointer = vbDefault
End Function

Function SaveFreq(ByVal sFileName As String, ByVal sID As String) As Boolean
    Dim i As Integer, j As Integer
   
    Dim nErr As Long
    
    Dim aFreq(8) As Single
    
    Dim sText As String
    
    'Default
    SaveFreq = True
    
    'Set mouse pointer
    MousePointer = vbHourglass
    
    'Open frequency data
    nErr = volOpenWFreq(sFileName, sID, nVRCount)
    If nErr < 0 Then
        'Reset mouse pointer
        MousePointer = vbDefault
        
        'Inform User
        Call volGetErr(nErr, sText)
        Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
        
        'Error
        SaveFreq = False
        Exit Function
    End If

    'Loop thru frequency data
    For i = 0 To nVRCount - 1
        'Loop thru level data
        For j = 0 To 7
            aFreq(j) = -SldLev(j + (i * 8)).Value / 100
        Next j
        
        'Write frequency data
        nErr = volWriteFreq(aFreq(0))
        If nErr < 0 Then
            'Reset mouse pointer
            MousePointer = vbDefault
                
            'Inform User
            Call volGetErr(nErr, sText)
            Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
                
            'Close frequency data
            Call volCloseWFreq
            
            'Error
            SaveFreq = False
            Exit Function
        End If
    Next i
    
    'Close frequency data
    nErr = volCloseWFreq()
    If nErr < 0 Then
        'Reset mouse pointer
        MousePointer = vbDefault
        
        'Inform User
        Call volGetErr(nErr, sText)
        Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
        
        'Error
        SaveFreq = False
        Exit Function
    End If
    
    'Reset mouse pointer
    MousePointer = vbDefault
End Function

Private Sub CmdClose_Click()
    'Hide form
    Hide
    FrmVol.Show
End Sub

Private Sub CmdOpen_Click()
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show common dialog
    CDLookup.FileName = sVolFile
    CDLookup.DefaultExt = ""
    CDLookup.DialogTitle = "Load Volume Lookup Table"
    CDLookup.ShowOpen
    sVolFile = CDLookup.FileName
    
    'Reset handler for Cancel button
    On Error GoTo 0
    
    'Open volume lookup table
    If OpenLookup(sVolFile, 0) = False Then Exit Sub
    
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show common dialog
    CDLookup.FileName = sRangeFile
    CDLookup.DefaultExt = ""
    CDLookup.DialogTitle = "Load Range Lookup Table"
    CDLookup.ShowOpen
    sRangeFile = CDLookup.FileName
    
    'Reset handler for Cancel button
    On Error GoTo 0
    
    'Open range lookup table
    If OpenLookup(sRangeFile, 1) = False Then Exit Sub
    
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show common dialog
    CDLookup.FileName = sFreqFile
    CDLookup.DefaultExt = ""
    CDLookup.DialogTitle = "Load Frequency Data"
    CDLookup.ShowOpen
    sFreqFile = CDLookup.FileName
    
    'Reset handler for Cancel button
    On Error GoTo 0
    
    'Open frequency data
    If OpenFreq(sFreqFile) = False Then Exit Sub
    Exit Sub
        
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub CmdReset_Click()
    Dim n As Integer
    
    'Reset all sliders
    For n = 0 To 23
        SldLev(n).Value = -100
    Next n
End Sub

Private Sub CmdSave_Click()
    'Show info
    FrmInfo.Show
    FrmInfo.Refresh
    
    'Save volume lookup table
    If SaveLookup(sVolFile, sVolID, 0) = False Then GoTo Error
    
    'Save range lookup table
    If SaveLookup(sRangeFile, sRangeID, 1) = False Then GoTo Error
    
    'Save frequency data
    If SaveFreq(sFreqFile, sFreqID) = False Then GoTo Error
    
Error:
    'Hide info
    FrmInfo.Hide
    Exit Sub
End Sub

Private Sub CmdSaveAs_Click()
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show common dialog
    CDLookup.FileName = sVolFile
    CDLookup.DefaultExt = ".lut"
    CDLookup.DialogTitle = "Save Volume Lookup Table"
    CDLookup.ShowSave
    sVolFile = CDLookup.FileName
    
    'Reset handler for Cancel button
    On Error GoTo 0
    
    'Save volume lookup table
    If SaveLookup(sVolFile, sVolID, 0) = False Then Exit Sub
    
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show common dialog
    CDLookup.FileName = sRangeFile
    CDLookup.DefaultExt = ".lut"
    CDLookup.DialogTitle = "Save Range Lookup Table"
    CDLookup.ShowSave
    sRangeFile = CDLookup.FileName
    
    'Reset handler for Cancel button
    On Error GoTo 0
    
    'Save range lookup table
    If SaveLookup(sRangeFile, sRangeID, 1) = False Then Exit Sub
    
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show common dialog
    CDLookup.FileName = sFreqFile
    CDLookup.DefaultExt = ".lut"
    CDLookup.DialogTitle = "Save Frequency Data"
    CDLookup.ShowSave
    sFreqFile = CDLookup.FileName
    
    'Reset handler for Cancel button
    On Error GoTo 0
    
    'Save frequency data
    If SaveFreq(sFreqFile, sFreqID) = False Then Exit Sub
    Exit Sub
        
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub FGLookup_DblClick()
    Call FlexGridEdit(FGLookup, TxtLookup, 32)
End Sub

Private Sub FGLookup_GotFocus()
    If TxtLookup.Visible = False Then Exit Sub
    FGLookup = TxtLookup
    TxtLookup.Visible = False
End Sub

Private Sub FGLookup_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 46 Then FGLookup.Text = ""
End Sub

Private Sub FGLookup_KeyPress(KeyAscii As Integer)
    Call FlexGridEdit(FGLookup, TxtLookup, KeyAscii)
End Sub

Private Sub FGLookup_LeaveCell()
    If TxtLookup.Visible = False Then Exit Sub
    FGLookup = TxtLookup
    TxtLookup.Visible = False
End Sub

Private Sub Form_Load()
    'Set form caption
    Caption = "VolTool - " + sHeadFile
       
    'Reset controls
    TxtLookup.Text = ""
    FGLookup.ColWidth(0) = FGLookup.ColWidth(0) * 2
    
    'Show tab
    ShowTab
    
    'Show labels
    ShowLabels
    
    'Open volume lookup table
    Call OpenLookup(sVolFile, 0)
    
    'Open range lookup table
    Call OpenLookup(sRangeFile, 1)
    
    'Open frequency data
    Call OpenFreq(sFreqFile)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    'Cancel unload
    Cancel = 1
    
    'End program
    AntiMain
End Sub

Private Sub TSLookup_Click()
    'Show tab
    ShowTab
End Sub

Private Sub TxtLookup_KeyDown(KeyCode As Integer, Shift As Integer)
    Call EditKeyCode(FGLookup, TxtLookup, KeyCode, Shift)
End Sub

Private Sub TxtLookup_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then KeyAscii = 0
End Sub