frmfront.frm

游戏《家园》源码

            
            'Find object
            Call rendFindObj(nObj, Val(Mid(sCurKey, 2)))
            Call rendGetObjScale(nObj, fX, fY, fZ)
            
            'Update status bar
            sbStatusBar.Panels.Item(1).Text = "Object Scale: x" + Format(fX * 100, " 0; -#") + " y" + Format(fY * 100, " 0; -#") + " z" + Format(fZ * 100, " 0; -#") + " %"
           
            'Refresh
            Render
            frmCamera.Render
            frmSide.Render
            frmTop.Render
        End If
        
        'Set level-of-detail to high
        SetDetail (0)
        frmCamera.SetDetail (0)
        frmSide.SetDetail (0)
        frmTop.SetDetail (0)
    End If
    
    'Get cursor
    aMouse(0) = aCursor(0)
    aMouse(1) = -(((Y - pbViewPort.Height / 2) / fConvScale) + aOffset(1)) / fViewScale
    aMouse(2) = -(((X - pbViewPort.Width / 2) / fConvScale) + aOffset(2)) / fViewScale
        
    'Check mouse down flag
    If bClick = False Then
        'Update status bar
        sbStatusBar.Panels.Item(1).Text = "Cursor: x" + Format(aMouse(0), " 0; -#") + " y" + Format(aMouse(1), " 0; -#") + " z" + Format(aMouse(2), " 0; -#") + " m"
        If fMainForm.mnuViewGraphSide.Checked Then frmSide.sbStatusBar.Panels.Item(1).Text = "Cursor: x" + Format(aMouse(0), " 0; -#") + " y" + Format(aMouse(1), " 0; -#") + " z" + Format(aMouse(2), " 0; -#") + " m"
        If fMainForm.mnuViewGraphTop.Checked Then frmTop.sbStatusBar.Panels.Item(1).Text = "Cursor: x" + Format(aMouse(0), " 0; -#") + " y" + Format(aMouse(1), " 0; -#") + " z" + Format(aMouse(2), " 0; -#") + " m"
    End If
    
    'Set mouse coordinates
    fMx = X
    fMy = Y
End Sub

Private Sub pbViewPort_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim n As Integer
    Dim nCount As Integer
    Dim nPos As Long
    Dim nObj As Long
    Dim nKey As Long
    Dim fX As Single
    Dim fY As Single
    Dim fZ As Single
    Dim fS As Single
    Dim sText As String
    Dim sKey As String
    Dim sList As String
    
    'Check mouse down flag
    If bClick = False Then Exit Sub
    
    'Check mouse for special case (both buttons)
    If Button <> 0 And Button <> 3 And nButton = 3 Then Exit Sub
    
    'Reset mouse down flag
    bClick = False
    
    'Check mouse and key state
    If nButton = 1 And nShift = 1 Then
        'Show options
        frmOptions.ShowOptions
        
        'Set scale
        SetView (True)
        frmTop.SetView (True)
        frmSide.SetView (True)
        Exit Sub
    End If
    
    'Check mouse and key state
    If nButton = 3 And nShift = 1 Then
        'Show options
        frmOptions.ShowOptions
        
        'Set view and scale
        SetView (False)
        SetScale (True)
        frmTop.SetView (False)
        frmTop.SetScale (True)
        frmSide.SetView (False)
        frmSide.SetScale (True)
        Exit Sub
    End If
    
    'Check mouse and key state
    If nButton = 1 And nShift = 4 And bGridFlag = 1 Then
        'Get absolute translation
        fX = (fRx - X) / (fConvScale * fViewScale)
        fY = (fRy - Y) / (fConvScale * fViewScale)
        
        'Snap x translation to grid
        If Abs(fX) Mod fGridSize < fGridSize / 2 Then
            fX = -(fX Mod fGridSize)
        Else
            fX = Sgn(fX) * fGridSize - (fX Mod fGridSize)
        End If

        'Snap y translation to grid
        If Abs(fY) Mod fGridSize < fGridSize / 2 Then
            fY = -(fY Mod fGridSize)
        Else
            fY = Sgn(fY) * fGridSize - (fY Mod fGridSize)
        End If
    
        'Translate object
        Call rendTransSel(0, fY, fX)
           
        'Refresh
        Render
        frmTop.Render
        frmSide.Render
        frmCamera.Render
    End If

    'Check mouse and key state
    If nButton = 2 And nShift = 4 Then
        'Check rotation flag
        If bRotFlag = 1 Then
            'Snap rotation
            If Abs(fAng) Mod fRotAngle < fRotAngle / 2 Then
                fAng = -(fAng Mod fRotAngle)
            Else
                fAng = Sgn(fAng) * fRotAngle - (fAng Mod fRotAngle)
            End If
        
            'Check key
            If InStr(sListKey, " ") = 0 Then
                'Rotate selection
                Call rendRotSel(0, fAng, 0, 0)
            Else
                'Rotate selection
                Call rendRotSel(nContext, fAng, 0, 0)
            End If
        End If
        
        'Set context rotation
        Call rendSetContRot(nContext, 0, nRotCol)
        
        'Refresh
        Render
        frmTop.Render
        frmSide.Render
        frmCamera.Render
    End If
        
    'Check mouse and key state
    If (nButton = 1 Or nButton = 2 Or nButton = 3) And nShift = 4 Then
        'Get selection
        Call rendGetSel("o", nCount, sList)
                    
        'Check count
        If nCount > 0 Then
            'Commit
            Call CommitDB("Edit Object")
            
            'Loop
            For n = 0 To nCount - 1
                'Get position of space character in string
                nPos = InStr(sList, " ")
            
                'If possible, truncate string at space character
                If nPos > 0 Then
                    'Edit object
                    sKey = Left(sList, nPos - 1)
                    frmObjects.EditObject (Val(Mid(sKey, 2)))
                    sList = Mid(sList, nPos + 1, Len(sList))
                Else
                    'Edit object
                    frmObjects.EditObject (Val(Mid(sList, 2)))
                End If
            Next n
        End If
        
        'Refresh
        Render
        frmTop.Render
        frmSide.Render
        frmCamera.Render
        Exit Sub
    End If
    
    'Check mouse and key state
    If nButton = 1 And nShift = 0 Then
        'Set object mode
        Call rendCheckContSel(nContext, 2, nKey)
        
        'Get selection
        Call rendGetSel("o", nCount, sList)
        
        'Check count
        If nCount > 0 Then
            'Truncate list
            sList = TruncStr(sList)
           
            'Check mouse
            If Abs(X - fRx) = 0 And Abs(Y - fRy) = 0 Then
                'Get next item
                sList = NextStr(sList, sCurKey, " ")
                
                'Select objects
                Call rendSetSel("o", sList)
            End If
                   
            'Select in tree
            frmTree.SelTree (sList)
        Else
            'Select in tree
            If Left(sCurKey, 1) = "o" Then
                frmTree.SelTree (sParKey)
            Else
                frmTree.SelTree ("l")
            End If
        End If
        
        'Refresh
        Render
        frmTop.Render
        frmSide.Render
        frmCamera.Render
        Exit Sub
    End If
    
    'Check mouse and key state
    If nButton = 1 And nShift = 2 Then
        'Toggle object mode
        Call rendCheckContSel(nContext, 3, nKey)
        
        'Get selection
        Call rendGetSel("o", nCount, sList)
        
        'Check count
        If nCount > 0 Then
            'Truncate list
            sList = TruncStr(sList)

            'Select in tree
            frmTree.SelTree (sList)
        Else
            'Select in tree
            If Left(sCurKey, 1) = "o" Then
                frmTree.SelTree (sParKey)
            Else
                frmTree.SelTree ("l")
            End If
        End If
               
        'Refresh form
        Render
        frmTop.Render
        frmSide.Render
        frmCamera.Render
        Exit Sub
    End If
    
    'Check mouse and key state
    If nButton = 2 And nShift = 0 Then
        'Get selection
        Call rendGetSel("o", nCount, sList)
        
        'Check count
        If nCount > 1 Then
            'Truncate list
            sList = TruncStr(sList)

            'Select in tree
            frmTree.SelTree (sList)
            
            ' Show popup menu
            Call PopupMenu(fMainForm.mnuPUGraphSel, 2)
            Exit Sub
        End If
        
        'Check count
        If nCount > 0 Then
            'Truncate list
            sList = TruncStr(sList)

            'Select in tree
            frmTree.SelTree (sList)
            
            ' Show popup menu
            Call PopupMenu(fMainForm.mnuPUGraphObj, 2)
            Exit Sub
        End If
        
        ' Show popup menu
        Call PopupMenu(fMainForm.mnuPUGraphDef, 2)
        Exit Sub
    End If
    
    'Check mouse and key state
    If nButton = 1 And nShift = 3 Then
        'Get cursor
        aCursor(1) = -(((Y - pbViewPort.Height / 2) / fConvScale) + aOffset(1)) / fViewScale
        aCursor(2) = -(((X - pbViewPort.Width / 2) / fConvScale) + aOffset(2)) / fViewScale
        
        'Check grid flag
        If bGridFlag = 1 Then
            'Snap cursor y to grid
            If Abs(aCursor(1)) Mod fGridSize < fGridSize / 2 Then
                aCursor(1) = -(aCursor(1) Mod fGridSize) + aCursor(1)
            Else
                aCursor(1) = Sgn(aCursor(1)) * fGridSize - (aCursor(1) Mod fGridSize) + aCursor(1)
            End If
        
            'Snap cursor z to grid
            If Abs(aCursor(2)) Mod fGridSize < fGridSize / 2 Then
                aCursor(2) = -(aCursor(2) Mod fGridSize) + aCursor(2)
            Else
                aCursor(2) = Sgn(aCursor(2)) * fGridSize - (aCursor(2) Mod fGridSize) + aCursor(2)
            End If
        End If
    
        'Set view
        SetCursor (True)
        frmTop.SetCursor (True)
        frmSide.SetCursor (True)
        Exit Sub
    End If
    
    'Check mouse and key state
    If nButton = 2 And nShift = 2 Then
        'Show options
        frmOptions.ShowOptions
        
        'Set camera
        SetCamera (True)
        frmTop.SetCamera (True)
        frmSide.SetCamera (True)
        frmCamera.SetCamera (True)
    End If
End Sub

Private Sub pbViewPort_Paint()
    'Render
    Call rendPaintCont(nContext)
End Sub

Private Sub Form_Resize()
    'Resize form
    On Error Resume Next
    Call pbViewPort.Move(0, 0, Me.ScaleWidth, Me.ScaleHeight - sbStatusBar.Height)
    On Error GoTo 0
    
    'Set view
    Call rendSetContView(nContext, (-pbViewPort.Width / (fConvScale * 2)) + aOffset(2), (-pbViewPort.Height / (fConvScale * 2)) + aOffset(1), pbViewPort.Width / fConvScale, pbViewPort.Height / fConvScale)
    
    'Render
    Call rendResizeCont(nContext)
End Sub