frmattribs.frm

游戏《家园》源码

         'Reset link
         Call rendFindObj(nObj, nKey)
         Call rendSetObjLink(nObj, 0)
    End If
    
    'Check parent
    If sPKey = "" Or sFile <> "" Then Exit Sub
    
    'Select in tree
    Call frmTree.SelTree(sPKey)
    
    'Get list
    Call frmList.GetList(sPKey, "")
    
    'Check parent
    If nKey > 0 And nObj > 0 Then
        'Refresh graphics
        frmFront.Render
        frmTop.Render
        frmSide.Render
        frmCamera.Render
    End If
End Sub

Sub DelAttribs(ByVal sKey As String, ByVal sFile As String)
    Dim nKey As Long
    Dim nObj As Long

    Dim sQuery As String
    
    Dim rsTemp As Recordset
            
    'Check file
    If sFile = "" Then
        'Check DB
        If bDBFlag = False Then Exit Sub
    End If
    
    'Check key
    If sKey = "" Then Exit Sub
    If Left(sKey, 1) = "m" Then Exit Sub
    If Left(sKey, 1) = "a" Then Exit Sub
    
    'Check file
    If sFile = "" Then
        'Check recordset
        If rsAttribs.BOF = True Then Exit Sub
    End If
    
    'Check key
    If Left(sKey, 1) = "l" Then
        'Set query
        sQuery = "SELECT * FROM Attrib WHERE Level = " + Mid(sKey, 2) + " AND Object = 0 ORDER BY Key"
    End If
    
    'Check key
    If Left(sKey, 1) = "o" Then
        'Set query
        sQuery = "SELECT * FROM Attrib WHERE Level = 0 AND Object = " + Mid(sKey, 2) + " ORDER BY Key"
    End If
        
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, sFile) = False Then Exit Sub
        
    'Delete data in recordset
    rsTemp.MoveFirst
    Do Until rsTemp.EOF
        'Get key
        nKey = rsTemp!Key
    
        'Delete attrib
        rsTemp.Delete
        
        'Delete from tree
        Call frmTree.DelTree("a" + Trim(Str(nKey)))
        rsTemp.MoveNext
    Loop
    
    'Close temporary recordset
    Call CloseRecordSetByQuery(rsTemp, sFile)
End Sub

Sub CopyAttrib(ByVal sSrcKey As String, ByVal sDstKey As String, ByVal bFlag As Boolean, ByVal sSrcFile As String)
    Dim nKey As Long
    
    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check source
    If sSrcKey = "" Then Exit Sub
    If Left(sSrcKey, 1) <> "a" Then Exit Sub
    
    'Check destination
    If sDstKey = "" Then Exit Sub
    If Left(sDstKey, 1) = "m" Then Exit Sub
    If Left(sDstKey, 1) = "a" Then Exit Sub
       
    'Check source file
    If sSrcFile = "" Then
        'Check recordset
        If rsAttribs.BOF = True Then Exit Sub
    End If
    
    'Set query
    sQuery = "SELECT * FROM Attrib WHERE Key = " + Mid(sSrcKey, 2)
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, sSrcFile) = False Then Exit Sub
        
    'Get data from recordset
    rsTemp.MoveFirst

    'Add data to recordset
    rsAttribs.AddNew
    nKey = rsAttribs!Key
    
    'Check destination
    If Left(sDstKey, 1) = "l" Then
        rsAttribs!Level = Val(Mid(sDstKey, 2))
    Else
        rsAttribs!Level = 0
    End If
    
    'Check destination
    If Left(sDstKey, 1) = "o" Then
        rsAttribs!Object = Val(Mid(sDstKey, 2))
    Else
        rsAttribs!Object = 0
    End If
    
    'Copy data
    rsAttribs!Name = rsTemp!Name
    rsAttribs!Value = rsTemp!Value
    rsAttribs!Info = rsTemp!Info
    rsAttribs.Update
    
    'Add to tree
    Call frmTree.AddTree(sDstKey, "a" + Trim(Str(nKey)))
    
    'Close temporary recordset
    Call CloseRecordSetByQuery(rsTemp, sSrcFile)
    
    'Check flag
    If bFlag = True Then Call DelAttrib("", sSrcKey, sSrcFile)
    
    'Select in tree
    Call frmTree.SelTree("a" + Trim(Str(nKey)))
End Sub

Sub CopyAttribs(ByVal sSrcKey As String, ByVal sDstKey As String, ByVal sSrcFile As String)
    Dim nKey As Long

    Dim sQuery As String
    
    Dim rsTemp As Recordset
    
    'Check DB
    If bDBFlag = False Then Exit Sub
    
    'Check destination
    If sDstKey = "" Then Exit Sub
    If Left(sDstKey, 1) = "m" Then Exit Sub
    If Left(sDstKey, 1) = "a" Then Exit Sub
    
    'Check source file
    If sSrcFile = "" Then
        'Check recordset
        If rsAttribs.BOF = True Then Exit Sub
    End If
    
    'Reset Query
    sQuery = ""
    
    'Check source
    If Left(sSrcKey, 1) = "l" Then
        'Set query
        sQuery = "SELECT * FROM Attrib WHERE Level = " + Mid(sSrcKey, 2) + " AND Object = 0 ORDER BY Key"
    End If
    
    'Check source
    If Left(sSrcKey, 1) = "o" Then
        'Set query
        sQuery = "SELECT * FROM Attrib WHERE Level = 0 AND Object = " + Mid(sSrcKey, 2) + " ORDER BY Key"
    End If
    
    'Check query
    If sQuery = "" Then Exit Sub
    
    'Open temporary recordset by query
    If OpenRecordSetByQuery(sQuery, rsTemp, sSrcFile) = False Then Exit Sub
        
    'Get data from recordset
    rsTemp.MoveFirst
    Do Until rsTemp.EOF
        'Add data to recordset
        rsAttribs.AddNew
        nKey = rsAttribs!Key
    
        'Check destination
        If Left(sDstKey, 1) = "l" Then
            rsAttribs!Level = Val(Mid(sDstKey, 2))
        Else
            rsAttribs!Level = 0
        End If
    
        'Check destination
        If Left(sDstKey, 1) = "o" Then
            rsAttribs!Object = Val(Mid(sDstKey, 2))
        Else
            rsAttribs!Object = 0
        End If
    
        'Copy data
        rsAttribs!Name = rsTemp!Name
        rsAttribs!Value = rsTemp!Value
        rsAttribs!Info = rsTemp!Info
        rsAttribs.Update
    
        'Add to tree
        Call frmTree.AddTree(sDstKey, "a" + Trim(Str(nKey)))
        rsTemp.MoveNext
    Loop
    
    'Close temporary recordset
    Call CloseRecordSetByQuery(rsTemp, sSrcFile)
End Sub

Sub BrowseAttrib()
    'Set handler for Cancel button
    On Error GoTo Cancel
    
    'Show open common dialog
    cdBrowse.InitDir = sDataDir
    cdBrowse.ShowOpen
    
    'Find data directory in full filename
    If InStr(1, cdBrowse.FileName, sDataDir, vbTextCompare) > 0 Then
        'Remove data directory
        cmbValue.Text = Mid(cdBrowse.FileName, Len(sDataDir) + 1, Len(cdBrowse.FileName))
    Else
        'Keep full filename
        cmbValue.Text = cdBrowse.FileName
    End If
    Exit Sub
    
    'Cancel button handler
Cancel:
    Exit Sub
End Sub

Private Sub cmbName_Change()
    'Reset color
    cmbName.BackColor = vbWindowBackground
End Sub

Private Sub cmbName_Click()
    'Reset color
    cmbName.BackColor = vbWindowBackground
End Sub
    
Private Sub cmbValue_Change()
    'Reset color
    cmbValue.BackColor = vbWindowBackground
End Sub

Private Sub cmbValue_Click()
    'Reset color
    cmbValue.BackColor = vbWindowBackground
End Sub

Private Sub cmdApply_Click()
    'Commit
    Call CommitDB("Edit Attribute")
    
    'Put attrib
    PutAttrib
    
    'Get names
    If cmbName.BackColor = vbWindowBackground Then GetNames (cmbName.Text)
    
    'Get values
    If cmbValue.BackColor = vbWindowBackground Then GetValues (cmbValue.Text)
End Sub

Private Sub cmdBrowse_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Check mouse button
    If Button = 2 Then
        'Show menu
        Call PopupMenu(fMainForm.mnuPUAttribVal, 2)
        Exit Sub
    End If
    
    'Browse
    BrowseAttrib
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    'Commit
    Call CommitDB("Edit Attribute")
    
    'Put attrib
    PutAttrib
    
    Unload Me
End Sub

Private Sub Form_Load()
    Dim n As Integer
    Dim nCount As Integer
    
    Dim nPos As Long
        
    Dim sList As String

    'Set tree view position
    aPos(0) = fMainForm.ScaleWidth / 4
    aPos(1) = fMainForm.ScaleHeight / 4
    
    'Reset count
    nCount = 0
    
    'Get window
    Call misGetListByKey(MIS_SEC_COM, MIS_KEY_ATTRIBT, sList, nCount, MIS_MOD_INI)
    
    'Check count
    If nCount > 0 Then
        'Truncate list
        sList = TruncStr(sList)

        'Loop thru list
        For n = 0 To 1
            'Get position of | character in string
            nPos = InStr(sList, "|")
        
            'If possible, truncate string at | character
            If nPos > 0 Then
                'Set position
                aPos(n) = Val(Left(sList, nPos - 1)) * fConvScale
                sList = Mid(sList, nPos + 1, Len(sList))
            Else
                'Set position
                aPos(n) = Val(sList) * fConvScale
            End If
        Next n
    End If
    
    'Initialize form
    On Error Resume Next
    Call Me.Move(aPos(0), aPos(1))
    On Error GoTo 0
    fMainForm.mnuViewTabAttrib.Checked = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim n As Integer
    
    Dim sList As String
    
    'Cleanup form
    fMainForm.mnuViewTabAttrib.Checked = False

    'Check position
    If aPos(0) = Me.Left And aPos(1) = Me.Top Then Exit Sub
    
    'Set position
    aPos(0) = Me.Left
    aPos(1) = Me.Top
    
    'Reset list
    sList = ""
    For n = 0 To 1
        'Append list
        sList = sList + "|" + Format(aPos(n) / fConvScale, "0.0;-0.0")
    Next n
    
    'Put window
    Call misPutListByKey(MIS_SEC_COM, MIS_KEY_ATTRIBT, sList, MIS_MOD_INI)
End Sub

Private Sub cmbValue_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Check data
    If Data.GetFormat(vbCFFiles) Then
        cmbValue.Text = Data.Files.Item(1)
    End If
End Sub

Private Sub cmbValue_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
    'Check data
    If Data.GetFormat(vbCFFiles) Then
        'Inform the source of the action to be taken
        Effect = vbDropEffectCopy And Effect
        Exit Sub
    End If
    
    'No drop
    Effect = vbDropEffectNone
End Sub

Private Sub txtInfo_Change()
    'Reset color
    txtInfo.BackColor = vbWindowBackground
End Sub