frmcamera.frm

游戏《家园》源码

        Call rendTransContCamera(nContext, fDist / (MIS_CAM_SCALE * 0.1), 0)
    End If
                   
    If KeyCode = vbKeyUp And Shift = 0 Then
        'Rotate camera
        Call rendRotContCamera(nContext, 0, 2.5)
    End If
        
    If KeyCode = vbKeyDown And Shift = 0 Then
        'Rotate camera
        Call rendRotContCamera(nContext, 0, -2.5)
    End If
        
    If KeyCode = vbKeyLeft And Shift = 0 Then
        'Rotate camera
        Call rendRotContCamera(nContext, 2.5, 0)
    End If
        
    If KeyCode = vbKeyRight And Shift = 0 Then
        'Rotate camera
        Call rendRotContCamera(nContext, -2.5, 0)
    End If
                       
    If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Or KeyCode = vbKeyLeft Or KeyCode = vbKeyRight Then
        'Set key press flag
        bPress = True
        
        'Set level-of-detail to low
        SetDetail (1)
        
        'Get camera eye and focus
        Call rendGetContCamera(nContext, aEye(0), aFocus(0))

        'Update status bar
        sbStatusBar.Panels.Item(1).Text = "Camera Eye: x" + Format(aEye(0), " 0; -#") + " y" + Format(aEye(1), " 0; -#") + " z" + Format(aEye(2), " 0; -#") + " m"
        sbStatusBar.Panels.Item(2).Text = "Camera Focus: x" + Format(aFocus(0), " 0; -#") + " y" + Format(aFocus(1), " 0; -#") + " z" + Format(aFocus(2), " 0; -#") + " m"
        
        'Refresh
        Render
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then KeyAscii = 0
    
    'Check key state
    If KeyAscii = Asc("-") Then
        'Scale camera
        Call rendScaleContCamera(nContext, 1 + 0.05)
    End If
        
    'Check key state
    If KeyAscii = Asc("+") Then
        'Scale camera
        Call rendScaleContCamera(nContext, 1 - 0.05)
    End If
        
    'Check key state
    If (KeyAscii = Asc("-")) Or (KeyAscii = Asc("+")) Then
        'Set key press flag
        bPress = True
    
        'Set level-of-detail to low
        SetDetail (1)
        
        'Get camera eye and focus
        Call rendGetContCamera(nContext, aEye(0), aFocus(0))

        'Update status bar
        sbStatusBar.Panels.Item(1).Text = "Camera Eye: x" + Format(aEye(0), " 0; -#") + " y" + Format(aEye(1), " 0; -#") + " z" + Format(aEye(2), " 0; -#") + " m"
        sbStatusBar.Panels.Item(2).Text = "Camera Focus: x" + Format(aFocus(0), " 0; -#") + " y" + Format(aFocus(1), " 0; -#") + " z" + Format(aFocus(2), " 0; -#") + " m"
        
        'Refresh
        Render
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If bPress = True Then
        'Set level-of-detail to high
        SetDetail (0)
        
        'Refresh
        Render
        
        'Set camera
        frmFront.SetCamera (True)
        frmTop.SetCamera (True)
        frmSide.SetCamera (True)
        
        'Show options
        frmOptions.ShowOptions
        
        'Clear key press flag
        bPress = False
    End If
End Sub

Private Sub pbViewPort_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Set mouse down flag
    bClick = True
    
    'Set mouse and key
    nButton = Button
    nShift = Shift
End Sub

Private Sub pbViewPort_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim fDist As Single
    
    'Check mouse down flag
    If bClick = True Then
        If nButton <> Button Or nShift <> Shift Then
            Call pbViewPort_MouseUp(nButton, nShift, X, Y)
            Call pbViewPort_MouseDown(Button, Shift, X, Y)
            Exit Sub
        End If
        
        'Set level-of-detail to low
        SetDetail (1)
        
        'Check mouse and key state
        'If nButton = 1 And nShift = 1 Then
        If nButton = 1 Then
            'Calculate distance
            fDist = Sqr((aEye(0) - aFocus(0)) * (aEye(0) - aFocus(0)) + (aEye(1) - aFocus(1)) * (aEye(1) - aFocus(1)) + (aEye(2) - aFocus(2)) * (aEye(2) - aFocus(2)))
               
            'Translate camera
            Call rendTransContCamera(nContext, (X - fMx) * fDist / (MIS_CAM_SCALE * fConvScale), (Y - fMy) * fDist / (MIS_CAM_SCALE * fConvScale))
            
            'Get camera eye and focus
            Call rendGetContCamera(nContext, aEye(0), aFocus(0))
    
            'Update status bar
            sbStatusBar.Panels.Item(1).Text = "Camera Eye: x" + Format(aEye(0), " 0; -#") + " y" + Format(aEye(1), " 0; -#") + " z" + Format(aEye(2), " 0; -#") + " m"
            sbStatusBar.Panels.Item(2).Text = "Camera Focus: x" + Format(aFocus(0), " 0; -#") + " y" + Format(aFocus(1), " 0; -#") + " z" + Format(aFocus(2), " 0; -#") + " m"
            
            'Refresh
            Render
        End If
        
        'Check mouse and key state
        If nButton = 2 Then
            'Rotate camera
            Call rendRotContCamera(nContext, (X - fMx) / (fConvScale * 2), (fMy - Y) / (fConvScale * 2))
            
            'Get camera eye and focus
            Call rendGetContCamera(nContext, aEye(0), aFocus(0))
    
            'Update status bar
            sbStatusBar.Panels.Item(1).Text = "Camera Eye: x" + Format(aEye(0), " 0; -#") + " y" + Format(aEye(1), " 0; -#") + " z" + Format(aEye(2), " 0; -#") + " m"
            sbStatusBar.Panels.Item(2).Text = "Camera Focus: x" + Format(aFocus(0), " 0; -#") + " y" + Format(aFocus(1), " 0; -#") + " z" + Format(aFocus(2), " 0; -#") + " m"
            
            'Refresh
            Render
        End If
        
        'Check mouse and key state
        If nButton = 3 Then
            'Check mouse coordinates
            If Abs(fMx - X) > Abs(fMy - Y) Then
                'Scale camera
                Call rendScaleContCamera(nContext, 1 + (X - fMx) / (fConvScale * 200))
            Else
                'Scale camera
                Call rendScaleContCamera(nContext, 1 + (Y - fMy) / (fConvScale * 200))
            End If
        
            'Get camera eye and focus
            Call rendGetContCamera(nContext, aEye(0), aFocus(0))
    
            'Update status bar
            sbStatusBar.Panels.Item(1).Text = "Camera Eye: x" + Format(aEye(0), " 0; -#") + " y" + Format(aEye(1), " 0; -#") + " z" + Format(aEye(2), " 0; -#") + " m"
            sbStatusBar.Panels.Item(2).Text = "Camera Focus: x" + Format(aFocus(0), " 0; -#") + " y" + Format(aFocus(1), " 0; -#") + " z" + Format(aFocus(2), " 0; -#") + " m"
            
            'Refresh
            Render
        End If
        
        'Set level-of-detail to high
        SetDetail (0)
    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 nKey As Long
    Dim nObj As Long
    
    Dim fPosX As Single
    Dim fPosY As Single
    Dim fPosZ As Single
    
    Dim aBand(3) As Single
    
    '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 = 0 Then
    If 0 Then
        'Get band box coordinates
        aBand(0) = X / fConvScale
        aBand(1) = Y / fConvScale
        aBand(2) = X / fConvScale
        aBand(3) = Y / fConvScale
            
        'Set band box
        Call rendSetContBand(nContext, aBand(0), nBandCol)
        
        'Set object mode
        Call rendCheckContSel(nContext, 1, nKey)
        
        'Get object position
        Call rendFindObj(nObj, nKey)
        Call rendGetObjTrans(nObj, fPosX, fPosY, fPosZ)

        'Check object
        If nObj = 0 Then Exit Sub
        
        'Set focus
        aFocus(0) = fPosX
        aFocus(1) = fPosY
        aFocus(2) = fPosZ
    
        'Set camera
        SetCamera (True)
        frmFront.SetCamera (True)
        frmTop.SetCamera (True)
        frmSide.SetCamera (True)
        Exit Sub
    End If
    
    'Check mouse and key state
    'If (nButton = 1 And nShift = 1) Or nButton = 2 Or nButton = 3 Then
    If nButton = 1 Or nButton = 2 Or nButton = 3 Then
        'Refresh
        Render
        
        'Set camera
        frmFront.SetCamera (True)
        frmTop.SetCamera (True)
        frmSide.SetCamera (True)
        
        'Show options
        frmOptions.ShowOptions
    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 origin
    Call rendSetContView(nContext, -pbViewPort.Width / (fConvScale * 2), -pbViewPort.Height / (fConvScale * 2), pbViewPort.Width / fConvScale, pbViewPort.Height / fConvScale)
    
    'Render
    Call rendResizeCont(nContext)
End Sub