gameinterface.bas

超级C&C有没有搞错,VB还能编出这种即时策略游戏来!没错,这就是我们的超级C&C!虽然游戏经常无故退出,但是原码仍有很多可圈可点的地方.祝你早日编出中国的超级RA,超级KKND,超级星际,超级家园

End Sub
Sub SelectSingleUnit(Mouse3D As Point3D)
Dim Temppoint As Point3D
For I = 1 To ObjectsActive
  If CheckObject(I, OBJCHECK_ALIVE) = True Then
    If CheckObject(I, OBJCHECK_CANBESELECTED) = True Then
      If CheckIfPointIsOnUnit(I, Mouse3D) = True Then
        If KeyStates(KEY_SHIFT) = True Then
          ObjectSelectedList.IndexesActive = ObjectSelectedList.IndexesActive + 1
          ObjectSelectedList.Indexes(ObjectSelectedList.IndexesActive) = I
        Else
          ObjectSelectedList.IndexesActive = 1
          ObjectSelectedList.Indexes(1) = I
          Exit For
        End If
      End If
    End If
  End If
Next I
End Sub
Public Function CheckIfPointIsOnUnit(ObjIndex, PointPosition As Point3D) As Boolean
Dim Temppoint As Point3D
With Objects(ObjIndex)
    Temppoint = ProjectPointToView(.Position)
    SpriteXOffset = ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONX)
    SpriteYOffset = ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONY)
    PicIndex = SpriteStuff.Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).PicNum
    If PointPosition.X > Temppoint.X - SpriteXOffset Then
      If PointPosition.X < (Temppoint.X - SpriteXOffset) + Pics(PicIndex).Width Then
        If PointPosition.Y > Temppoint.Y - SpriteYOffset Then
          If PointPosition.Y < (Temppoint.Y - SpriteYOffset) + Pics(PicIndex).Height Then
            CheckIfPointIsOnUnit = True
          End If
        End If
      End If
    End If
End With
End Function
Public Function InClipper(X, Y, ClipRect As RECT) As Boolean
With ClipRect
  If X <= .Right + EXTRABORDER Then
    If X >= .Left - EXTRABORDER Then
      If Y >= .Top - EXTRABORDER Then
        If Y <= .bottom + EXTRABORDER Then
          InClipper = True
        End If
      End If
    End If
  End If
End With
End Function
Public Sub ProcessMouseInput()
'View Scrolling
If InClipper(Mouse.Position.X, Mouse.Position.Y, BattleViewPort.PortRect) = True Then
  Call ProcessWindow_BattleViewPort
End If
If InClipper(Mouse.Position.X, Mouse.Position.Y, GameControlPanel.PortRect) = True Then
  If Mouse.IsDragging = True Then
    Call ProcessWindow_BattleViewPort
  Else
    Call ProcessWindow_ControlPanel
  End If
End If
Call ProcessMiscMouse
For I = 1 To 5
  Mouse.OldButtonStates(I) = Mouse.ButtonStates(I)
Next I
End Sub
Sub ProcessWindow_ControlPanel()
Dim Building As Boolean
For I = 1 To MAXBUILDWINDOWS
  If InClipper(Mouse.Position.X, Mouse.Position.Y, BuildWindows(I).PortRect) = True Then
    If Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1) <= Player(LocalPlayer.PlayerIndex).BuildClassesActive Then
      If Mouse.ButtonStates(1) = True Then
        If Players.StartBuilding(LocalPlayer.PlayerIndex, Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)) = False Then
          For I2 = 1 To Player(LocalPlayer.PlayerIndex).BuildsInProgressesActive
            If Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).ClassReference = Player(LocalPlayer.PlayerIndex).BuildsInProgress(I2).ClassReference Then
              If Player(LocalPlayer.PlayerIndex).BuildsInProgress(I2).CanBePlaced = True Then
                InterfaceFlags.PlaceIndex = Player(LocalPlayer.PlayerIndex).BuildsInProgress(I2).ClassReference
                InterfaceFlags.PlacingABuilding = True
              End If
              Exit For
            End If
          Next I2
        End If
        Mouse.ButtonStates(1) = False
      ElseIf Mouse.ButtonStates(2) = True Then
        Call CancelBuild(LocalPlayer.PlayerIndex, Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1))
        Mouse.ButtonStates(2) = False
      End If
    End If
  End If
Next I
If InClipper(Mouse.Position.X, Mouse.Position.Y, RadarButton.PortRect) = True Then
  If Mouse.ButtonStates(1) = True Then
    If RadarWindow.Enabled = True Then
      RadarWindow.Enabled = False
    Else
      RadarWindow.Enabled = True
    End If
    Call GraphicsEngine.RedrawControlPanel
    Mouse.ButtonStates(1) = False
  End If
End If
End Sub
Sub ProcessMiscMouse()
If Mouse.IsDragging = True Then
    Mouse.DragCurrentPosition = Mouse.Position
    With BattleViewPort.PortRect
      If Mouse.Position.X < .Left Then
        Mouse.DragCurrentPosition.X = .Left
      End If
      If Mouse.Position.X > .Right - 1 Then
        Mouse.DragCurrentPosition.X = .Right - 1
      End If
      If Mouse.Position.Y < .Top - 1 Then
        Mouse.DragCurrentPosition.Y = .Top - 1
      End If
      If Mouse.Position.Y > .bottom - 1 Then
        Mouse.DragCurrentPosition.Y = .bottom - 1
      End If
    End With
Else
    With Mouse.Position
      If .X = 0 Then
        Call AddInertiaToScroll(DIRECTION_LEFT)
      End If
      If .Y = 0 Then
        Call AddInertiaToScroll(DIRECTION_UP)
      End If
      If .X = ResolutionX - 1 Then
        Call AddInertiaToScroll(DIRECTION_RIGHT)
      End If
      If .Y = ResolutionY - 1 Then
        Call AddInertiaToScroll(DIRECTION_DOWN)
      End If
    End With
End If
End Sub
Sub ProcessWindow_BattleViewPort()
If InterfaceFlags.PlacingABuilding = True Then
  If Mouse.ButtonStates(1) = True Then
    If ObjectSelectedList.IndexesActive = NOOBJECT Then
      Mouse.ButtonStates(1) = False
      MouseX = Map.ProjectToMapX(ProjectXToBattlefield(Mouse.Position.X))
      MouseY = Map.ProjectToMapY(ProjectYToBattlefield(Mouse.Position.Y))
      If Map.IsImprintSpaceOccupied(MouseX, MouseY, ObjModels(Player(PlayerIndex).BuildsInProgress(InterfaceFlags.PlaceIndex).ClassReference).MapImprintNumber) = False Then
        Call BuildBuilding(MouseX, MouseY, LocalPlayer.PlayerIndex)
      Else
        Beep
      End If
    End If
  End If
End If
If Mouse.OldButtonStates(1) = True Then
  'mouse has been pressed down
  If Mouse.ButtonStates(1) = False Then
    'Mouse has just been pressed and let go
    Call DetermineMouseDrag
    If Mouse.IsDragging = False Then
      If ObjectSelectedList.IndexesActive = NOOBJECT Then
        Call SelectSingleUnit(Mouse.Position)
      Else
        Call HandleUnitGroupInstructions(ProjectPointToBattlefield(Mouse.Position))
      End If
    Else
      Call SelectUnits(ProjectPointToBattlefield(Mouse.DragStartPosition), ProjectPointToBattlefield(Mouse.DragCurrentPosition))
    End If
  Else
    Call DetermineMouseDrag
  End If
Else
  Mouse.IsDragging = False
End If
If Mouse.ButtonStates(2) = True Then
  'Deselect Units
  GameInterface.ObjectSelectedList.IndexesActive = NOOBJECT
End If
End Sub
Public Sub StandbyMinimized()
Call TempCloseGraphicsDevice
ViewForm.WindowState = 1
Do
  DoEvents
  If ViewForm.WindowState <> 1 Then Exit Do
Loop
DoEvents
Call TempOpenGraphicsDevice
DoEvents
GraphicsEngine.GraphicsEngineData.TotalRefresh = True
End Sub
Sub MiscKeyboardProcessing()
Call CheckAltTab
End Sub
Public Sub CheckAltTab()
If KeyStates(KEY_TAB) = True Then
  If KeyStates(KEY_ALT) = True Then
    Call StandbyMinimized
    Call ClearKeyStates
  End If
End If
End Sub
Public Sub ProcessKeyboardEvents()
If InterfaceFlags.WritingAMessage = True Then
    InterfaceFlags.Message = ViewForm.KeyboardInputBox.Text
    If KeyStates(KEY_ESCAPE) = True Then
      InterfaceFlags.WritingAMessage = False
    End If
    If KeyStates(KEY_ENTER) = True Then
      Call Internet.TransmitMessage(ViewForm.KeyboardInputBox.Text)
      InterfaceFlags.WritingAMessage = False
      ViewForm.KeyboardInputBox.Text = ""
    End If
    For I = 1 To 127
      KeyStates(I) = False
    Next I
Else
    If KeyStates(KEY_T) = True Then
      InterfaceFlags.WritingAMessage = True
      ViewForm.KeyboardInputBox.Text = ""
    End If
    If KeyStates(KEY_UP) = True Then
      Call AddInertiaToScroll(DIRECTION_UP)
    End If
    If KeyStates(KEY_DOWN) = True Then
      Call AddInertiaToScroll(DIRECTION_DOWN)
    End If
    If KeyStates(KEY_LEFT) = True Then
      Call AddInertiaToScroll(DIRECTION_LEFT)
    End If
    If KeyStates(KEY_RIGHT) = True Then
      Call AddInertiaToScroll(DIRECTION_RIGHT)
    End If
    If KeyStates(KEY_ESCAPE) = True Then
      Call GameEngine.CauseEngineInterrupt(IR_PLAYEREXITEDGAME)
    End If
End If
End Sub
Public Sub ClearSelectedListEntry(EntryNum)
For I = EntryNum To ObjectSelectedList.IndexesActive - 1
  ObjectSelectedList.Indexes(I) = ObjectSelectedList.Indexes(I + 1)
Next I
ObjectSelectedList.IndexesActive = ObjectSelectedList.IndexesActive - 1
End Sub
Public Function GetManualInstruction()
If KeyStates(KEY_CONTROL) = True Then
  If KeyStates(KEY_ALT) = True Then
    GetManualInstruction = INSTRUCTION_FORCEPROTECT
  Else
    GetManualInstruction = INSTRUCTION_FORCEATTACK
  End If
ElseIf KeyStates(KEY_ALT) = True Then
  GetManualInstruction = INSTRUCTION_FORCEMOVE
End If
End Function
Public Sub HandleUnitGroupInstructions(RealMouseClickPoint As Point3D)
Dim ClickPoint As Point3D
If ObjectSelectedList.IndexesActive < 1 Then Exit Sub
ManualInstruction = GetManualInstruction
For I = 1 To GameInterface.ObjectSelectedList.IndexesActive
  If CheckObject(ObjectSelectedList.Indexes(I), OBJCHECK_SELECTABLE) = True Then
    IgnoreCommand = False
    If ObjModels(Objects(ObjectSelectedList.Indexes(I)).ModelIndex).Abilities(ABILITY_DEPLOYS) Then
      If CheckIfPointIsOnUnit(ObjectSelectedList.Indexes(I), GameInterface.ProjectPointToView(RealMouseClickPoint)) = True Then
        If Objects(ObjectSelectedList.Indexes(I)).Side = LocalPlayer.PlayerIndex Then
          Objects(ObjectSelectedList.Indexes(I)).Frozen = True
          Call Events.SpawnEvent(Events.Event_DeployUnit, ObjectSelectedList.Indexes(I))
          IgnoreCommand = True
        End If
      End If
    End If
    If IgnoreCommand = False Then Call Events.SpawnEvent(Events.Event_DirectUnit, GameInterface.ObjectSelectedList.Indexes(I), RealMouseClickPoint.X, RealMouseClickPoint.Y, ManualInstruction)
  End If
Next I
End Sub
Function ProjectXToView(XVal) As Integer
ProjectXToView = (XVal - GameEngine.View.Left)
End Function
Function ProjectYToView(YVal) As Integer
ProjectYToView = (YVal - GameEngine.View.Top)
End Function
Function ProjectXToBattlefield(XVal) As Integer
ProjectXToBattlefield = (GameEngine.View.Left + XVal) - BattleViewPort.PortRect.Left
End Function
Function ProjectYToBattlefield(YVal) As Integer
ProjectYToBattlefield = (GameEngine.View.Top + YVal) - BattleViewPort.PortRect.Top
End Function
Public Function ProjectPointToView(OrigPoint As Point3D) As Point3D
ProjectPointToView.X = ProjectXToView(OrigPoint.X)
ProjectPointToView.Y = ProjectYToView(OrigPoint.Y)
ProjectPointToView.Z = OrigPoint.Z
End Function
Public Function ProjectPointToBattlefield(OrigPoint As Point3D) As Point3D
ProjectPointToBattlefield.X = ProjectXToBattlefield(OrigPoint.X)
ProjectPointToBattlefield.Y = ProjectYToBattlefield(OrigPoint.Y)
ProjectPointToBattlefield.Z = OrigPoint.Z
End Function