gameinterface.bas

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

Attribute VB_Name = "GameInterface"
Global Const EXTRABORDER = 5
Global Const MouseDragThreshhold = 4

Global Const MAXMOUSEBUTTONS = 5
'Mouse
Type MousePoint
  DragStartPosition As Point3D
  DragCurrentPosition As Point3D
  IsDragging As Boolean
  Position As Point3D
  OldButtonStates(1 To MAXMOUSEBUTTONS) As Boolean
  ButtonStates(1 To MAXMOUSEBUTTONS) As Boolean
  CursorPic As Integer
End Type
Public Mouse As MousePoint

'Keyboard
Global Const KEY_SHIFT = 16
Global Const KEY_ENTER = 13
Global Const KEY_ESCAPE = 27
Global Const KEY_T = 84
Global Const KEY_S = 83
Global Const KEY_D = 68
Global Const KEY_CONTROL = 17
Global Const KEY_ALT = 18
Global Const KEY_TAB = 9

Global Const KEY_UP = 38
Global Const KEY_DOWN = 40
Global Const KEY_LEFT = 37
Global Const KEY_RIGHT = 39


Global KeyStates(250) As Boolean

Type ObjectSelect
  MaxSelected As Integer
  SelectedList(MAXOBJECTS) As Integer
End Type
Type Interflags
  WritingAMessage As Boolean
  Message As String
  PlacingABuilding As Boolean
  PlaceIndex As Integer
End Type
Global InterfaceFlags As Interflags
Global ObjectSelectedList As IndexGroup
'Real stuff
Public Const INTERFACEWIDTH = 320
Public Const INTERFACEHEIGHT = 200
Public Const HALFINTERFACEWIDTH = INTERFACEWIDTH / 2
Public Const HALFINTERFACEHEIGHT = INTERFACEHEIGHT / 2
Private Const NOCONTROL = 0


Private Const MAXPROPERTIES = 10
Public Const CONTROLPROPERTY_TEXT = 1
Public Const CONTROLPROPERTY_PICTURE = 2
Public Const CONTROLPROPERTY_STATE = 3

Type PropertyArray
  Properties(MAXPROPERTIES) As Variant
End Type
Type ControlObject
  Outline As RECT
  ControlProperties As PropertyArray
  ControlType As Integer
End Type
Private Const MAXCONTROLAMOUNT = 30
Type ControlGroup
  ControlAmount As Integer
  ControlObjects(MAXCONTROLAMOUNT) As ControlObject
End Type
Type InterfaceReturnObj
  Controls As ControlGroup
  Canceled As Boolean
End Type
Type InterfaceObj
  BackgroundPic As Integer
  BackgroundSound As String
  MouseCursorPic As Integer
  Controls As ControlGroup
  ControlFocus As Integer
End Type
Public Const CONTROLTYPE_PICTUREBOX = 1
Public Const CONTROLTYPE_BUTTONLARGE = 2
Public Const CONTROLTYPE_LABEL = 3
Public Const CONTROLTYPE_TEXTBOX = 4
Public Function CreateControl(ControlType, X, Y, Width, Height, Content) As ControlObject
Dim NewControl As ControlObject
NewControl.ControlType = ControlType
Select Case ControlType
Case CONTROLTYPE_PICTUREBOX
  NewControl.ControlProperties.Properties(CONTROLPROPERTY_PICTURE) = Content
  NewControl.Outline.Top = Y - Int(Height / 2)
  NewControl.Outline.bottom = Y + Int(Height / 2)
  NewControl.Outline.Left = X - Int(Width / 2)
  NewControl.Outline.Right = X + Int(Width / 2)
Case CONTROLTYPE_BUTTONLARGE
  NewControl.ControlProperties.Properties(CONTROLPROPERTY_TEXT) = Content
  NewControl.ControlProperties.Properties(CONTROLPROPERTY_STATE) = False
  NewControl.Outline.Top = Y
  NewControl.Outline.bottom = Y + Height
  NewControl.Outline.Left = X
  NewControl.Outline.Right = X + Width
Case CONTROLTYPE_LABEL
  NewControl.ControlProperties.Properties(CONTROLPROPERTY_TEXT) = Content
  NewControl.Outline.Top = Y
  NewControl.Outline.bottom = Y + Height
  NewControl.Outline.Left = X
  NewControl.Outline.Right = X + Width
Case CONTROLTYPE_TEXTBOX
  NewControl.ControlProperties.Properties(CONTROLPROPERTY_TEXT) = Content
  NewControl.Outline.Top = Y - Int((Height * FONT_SPACINGY) / 2)
  NewControl.Outline.bottom = Y + Int((Height * FONT_SPACINGY) / 2)
  NewControl.Outline.Left = X - Int((Width * FONT_SPACINGX) / 2)
  NewControl.Outline.Right = X + Int((Width * FONT_SPACINGX) / 2)
End Select
CreateControl = NewControl
End Function
Public Function ProjectRectToCenterScreen(RectToConvert As RECT) As RECT
ProjectRectToCenterScreen.Left = (RectToConvert.Left - HALFINTERFACEWIDTH) + ResolutionMidX
ProjectRectToCenterScreen.Right = (RectToConvert.Right - HALFINTERFACEWIDTH) + ResolutionMidX
ProjectRectToCenterScreen.Top = (RectToConvert.Top - HALFINTERFACEHEIGHT) + ResolutionMidY
ProjectRectToCenterScreen.bottom = (RectToConvert.bottom - HALFINTERFACEHEIGHT) + ResolutionMidY
End Function
Private Sub DrawInterface(Interface As InterfaceObj)
Call GraphicsEngine.SplashGraphic(InGameConstants(InGameConstant_PICINDEX_ProgramBackground))
Call GraphicsEngine.DisplayText("JPI v" & VERSION, ResolutionMidX - HALFINTERFACEWIDTH, ResolutionMidY - HALFINTERFACEHEIGHT, PALLETE_YELLOW)
For I = 1 To Interface.Controls.ControlAmount
  'Display controls
  With Interface.Controls.ControlObjects(I)
    Select Case .ControlType
    Case CONTROLTYPE_PICTUREBOX
      Call GraphicsEngine.PutGraphicOntoBackBuffer(.Outline.Left + Pics(.ControlProperties.Properties(CONTROLPROPERTY_PICTURE)).HalfWidth, .Outline.Top + Pics(.ControlProperties.Properties(CONTROLPROPERTY_PICTURE)).HalfHeight, .ControlProperties.Properties(CONTROLPROPERTY_PICTURE), BltType_Mask)
    Case CONTROLTYPE_BUTTONLARGE
      Call GraphicsEngine.PutGraphicOntoBackBuffer(.Outline.Left + Pics(InGameConstants(InGameConstant_PICINDEX_ButtonLarge)).HalfWidth, .Outline.Top + Pics(InGameConstants(InGameConstant_PICINDEX_ButtonLarge)).HalfHeight, InGameConstants(InGameConstant_PICINDEX_ButtonLarge), BltType_Fast)
      Call GraphicsEngine.DisplayTextCenterRelative(.ControlProperties.Properties(CONTROLPROPERTY_TEXT), .Outline.Left + 70, .Outline.Top + 6, PALLETE_WHITE)
    Case CONTROLTYPE_TEXTBOX
      Call GraphicsEngine.DisplayText(.ControlProperties.Properties(CONTROLPROPERTY_TEXT), .Outline.Left, .Outline.Top + 1, PALLETE_YELLOW)
      Call GraphicsEngine.GethDC
      Call GraphicsEngine.DrawBox(.Outline.Left, .Outline.Top + 2, .Outline.Right, .Outline.bottom - 1, 255, 255, 255, 0, 0, 0, LINEMODE_NORMAL)
      Call GraphicsEngine.ReleasehDC
    Case CONTROLTYPE_LABEL
      Call GraphicsEngine.DisplayTextCenterRelative(.ControlProperties.Properties(CONTROLPROPERTY_TEXT), .Outline.Left + ((.Outline.Right - .Outline.Left) / 2), .Outline.Top + ((.Outline.bottom - .Outline.Top) / 2), PALLETE_YELLOW)
    End Select
  End With
Next I
End Sub
Public Function RunStaticInterface(InterfaceToRun As InterfaceObj) As InterfaceReturnObj
Dim InterfaceReturn As InterfaceReturnObj, Interface As InterfaceObj
ViewForm.KeyboardInputBox.Text = ""
Interface = InitializeInterfaceObj(InterfaceToRun)
Call ClearKeyStates
If InterfaceToRun.BackgroundSound <> "" Then Call Sound.Play_LoopSound(Sound.GetSoundIndex(InterfaceToRun.BackgroundSound), 100)
Do
  
  DoEvents
  If Interface.ControlFocus <> NOCONTROL Then
    If RunControlKeyboardInput(Interface.Controls.ControlObjects(Interface.ControlFocus)) = True Then
      Interface.ControlFocus = NOCONTROL
    End If
  End If
  For I = 1 To Interface.Controls.ControlAmount
    If RunControlMouseInput(Interface.Controls.ControlObjects(I)) = True Then
      Select Case Interface.Controls.ControlObjects(I).ControlType
      Case CONTROLTYPE_TEXTBOX
        Interface.ControlFocus = I
        ViewForm.KeyboardInputBox.Text = Interface.Controls.ControlObjects(I).ControlProperties.Properties(CONTROLPROPERTY_TEXT)
        ViewForm.KeyboardInputBox.SelStart = Len(ViewForm.KeyboardInputBox.Text)
        ViewForm.KeyboardInputBox.MaxLength = (Interface.Controls.ControlObjects(I).Outline.Right - Interface.Controls.ControlObjects(I).Outline.Left) / FONT_SPACINGX
      End Select
      If Interface.Controls.ControlObjects(I).ControlType = CONTROLTYPE_BUTTONLARGE Then
        Exit Do
      End If
    End If
  Next I
  Call GraphicsEngine.ClearBackBuffer
  Call DrawInterface(Interface)
  GraphicsEngine.SwapScreen
  'Display mouse cursor (make a sub DisplayMousecursor(CursorPic)
  If KeyStates(KEY_ESCAPE) = True Then
    RunStaticInterface.Canceled = True
    Exit Do
  End If
Loop
Call Sound.Stop_Sounds
RunStaticInterface.Controls = Interface.Controls
ViewForm.KeyboardInputBox.MaxLength = 0
End Function
Public Sub RunImmediateInterface(Interface As InterfaceObj)
For I = 1 To Interface.Controls.ControlAmount
'  Call RunControl(Interface.Controls.ControlObjects(I))
Next I
Call DrawInterface(Interface)
End Sub
Private Function RunControlMouseInput(Control As ControlObject) As Boolean
If InClipper(Mouse.Position.X, Mouse.Position.Y, Control.Outline) = True Then
  'run the mouse input
  If Mouse.ButtonStates(1) = True Then
    Mouse.ButtonStates(1) = False
    RunControlMouseInput = True
    If Control.ControlProperties.Properties(CONTROLPROPERTY_STATE) = False Then
      Control.ControlProperties.Properties(CONTROLPROPERTY_STATE) = True
    Else
      Control.ControlProperties.Properties(CONTROLPROPERTY_STATE) = False
    End If
  End If
End If
End Function
Private Function RunControlKeyboardInput(Control As ControlObject) As Boolean
'run the keyboard input
Control.ControlProperties.Properties(CONTROLPROPERTY_TEXT) = ViewForm.KeyboardInputBox.Text
If KeyStates(KEY_ENTER) = True Then
  RunControlKeyboardInput = True
End If
End Function
Public Function InitializeInterfaceObj(Interface As InterfaceObj) As InterfaceObj
InitializeInterfaceObj = Interface
For I = 1 To InitializeInterfaceObj.Controls.ControlAmount
  InitializeInterfaceObj.Controls.ControlObjects(I).Outline = ProjectRectToCenterScreen(InitializeInterfaceObj.Controls.ControlObjects(I).Outline)
Next I
End Function
Public Function ConstructInterface(InterfaceFile As String) As InterfaceObj
Dim NewInterface As InterfaceObj
'put load interface crap here!
NewInterface = InitializeInterfaceObj(NewInterface)
ConstructInterface = NewInterface
End Function
Public Sub ClearKeyStates()
For I = 0 To 250
  KeyStates(I) = False
Next I
End Sub
Public Sub InitializeInterface()
ViewForm.KeyboardInputBox.SetFocus
End Sub
Public Sub ClearMouseButtons()
For I = 1 To MAXMOUSEBUTTONS
  Mouse.ButtonStates(I) = False
  Mouse.OldButtonStates(I) = False
Next I
End Sub
Public Sub SelectUnits(StartPoint As Point3D, ClickPoint As Point3D)
If ClickPoint.X < StartPoint.X Then
  TmpX = ClickPoint.X
  ClickPoint.X = StartPoint.X
  StartPoint.X = TmpX
End If
If ClickPoint.Y < StartPoint.Y Then
  TmpY = ClickPoint.Y
  ClickPoint.Y = StartPoint.Y
  StartPoint.Y = TmpY
End If
GameInterface.ObjectSelectedList.IndexesActive = 0
For I = 1 To ObjectsActive
  If CheckObject(I, OBJCHECK_ALIVE) = True Then
    If CheckObject(I, OBJCHECK_CANBESELECTED) = True Then
      If Objects(I).Side = LocalPlayer.PlayerIndex Then
        If Objects(I).Position.X <= ClickPoint.X Then
          If Objects(I).Position.X >= StartPoint.X Then
            If Objects(I).Position.Y <= ClickPoint.Y Then
              If Objects(I).Position.Y >= StartPoint.Y Then
                If ObjModels(Objects(I).ModelIndex).BehaviorType = BEHAVIORMODE_TANK Then
                  GameInterface.ObjectSelectedList.IndexesActive = GameInterface.ObjectSelectedList.IndexesActive + 1
                  GameInterface.ObjectSelectedList.Indexes(GameInterface.ObjectSelectedList.IndexesActive) = I
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  End If
Next I
End Sub
Public Sub DetermineMouseDrag()
Mouse.IsDragging = True
If Mouse.Position.X < Mouse.DragStartPosition.X + MouseDragThreshhold Then
  If Mouse.Position.X > Mouse.DragStartPosition.X - MouseDragThreshhold Then
    If Mouse.Position.Y < Mouse.DragStartPosition.Y + MouseDragThreshhold Then
      If Mouse.Position.Y > Mouse.DragStartPosition.Y - MouseDragThreshhold Then
        Mouse.IsDragging = False
      End If
    End If
  End If
End If
If Mouse.IsDragging = True Then
  Mouse.IsDragging = False
  If Mouse.DragStartPosition.X > BattleViewPort.PortRect.Left - 1 Then
    If Mouse.DragStartPosition.Y > BattleViewPort.PortRect.Top - 1 Then
      If Mouse.DragStartPosition.X < BattleViewPort.PortRect.Right Then
        If Mouse.DragStartPosition.Y < BattleViewPort.PortRect.bottom Then
          Mouse.IsDragging = True
        End If
      End If
    End If
  End If
End If