graphicsengine.bas

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

Dim temprect As RECT
Select Case Direction
Case DIRECTION_UP
  With temprect
    .bottom = BattleViewPort.Height - Distance
    .Right = BattleViewPort.Width
  End With
  TerrainSurface.BltFast 0, Distance, TerrainSurface, temprect, 0
  For X = Map.ProjectToMapX(View.Left) To Map.ProjectToMapX(View.Left + View.Width)
    For Y = Map.ProjectToMapY(View.Top) To Map.ProjectToMapY(View.Top) + GraphicsEngineData.TerrainRefreshSize
      Call RenderTerrainBlock(X, Y)
    Next Y
  Next X
Case DIRECTION_RIGHT
  With temprect
    .bottom = BattleViewPort.Height
    .Right = BattleViewPort.Width
    .Left = Distance
  End With
  TerrainSurface.BltFast 0, 0, TerrainSurface, temprect, 0
  For Y = Map.ProjectToMapY(View.Top) To Map.ProjectToMapY(View.Top + View.Height)
    For X = Map.ProjectToMapX(View.Left + View.Width) - GraphicsEngineData.TerrainRefreshSize To Map.ProjectToMapX(View.Left + View.Width) + 1
      Call RenderTerrainBlock(X, Y)
    Next X
  Next Y
Case DIRECTION_DOWN
  With temprect
    .Top = Distance
    .bottom = BattleViewPort.Height
    .Right = BattleViewPort.Width
  End With
  TerrainSurface.BltFast 0, 0, TerrainSurface, temprect, 0
  For X = Map.ProjectToMapX(View.Left) To Map.ProjectToMapX(View.Left + View.Width)
    For Y = Map.ProjectToMapY(View.Top + View.Height) - GraphicsEngineData.TerrainRefreshSize To Map.ProjectToMapY(View.Top + View.Height)
      Call RenderTerrainBlock(X, Y)
    Next Y
  Next X
Case DIRECTION_LEFT
  With temprect
    .bottom = BattleViewPort.Height
    .Right = BattleViewPort.Width - Distance
  End With
  TerrainSurface.BltFast Distance, 0, TerrainSurface, temprect, 0
  For Y = Map.ProjectToMapY(View.Top) To Map.ProjectToMapY(View.Top + View.Height)
    For X = Map.ProjectToMapX(View.Left) To Map.ProjectToMapX(View.Left) + GraphicsEngineData.TerrainRefreshSize
      Call RenderTerrainBlock(X, Y)
    Next X
  Next Y
End Select
End Sub
Sub TilePic(PicIndex)
Dim temprect As RECT
With Pics(PicIndex)
  TileMaxX = Int(ResolutionX / .Width)
  TileMaxY = Int(ResolutionY / .Height)
  temprect.bottom = .Height
  temprect.Right = .Width
  For X = 0 To TileMaxX - 1
    For Y = 0 To TileMaxY - 1
      
      ddsBack.BltFast X * .Width, Y * .Height, GraphicSurfaces(Pics(PicIndex).GraphicsLib), temprect, DDBLTFAST_WAIT
    
    
    
    Next Y
  Next X
End With
End Sub
Sub DisplayControlPanel()
Dim temprect As RECT
With temprect
  .Right = GameControlPanel.Width
  .bottom = GameControlPanel.Height
End With
ddsBack.BltFast GameControlPanel.PortRect.Left, GameControlPanel.PortRect.Top, ControlPanelSurface, temprect, DDBLTFAST_WAIT
End Sub
Sub RenderMoneyValue()
Call DisplayText("CREDITS: " & Format$(Player(LocalPlayer.PlayerIndex).Money, "0000"), 1, 1, PALLETE_WHITE)
End Sub
Sub RenderRadar()
If RadarWindow.Enabled = True Then
  ddsBack.BltFast RadarWindow.PortRect.Left, RadarWindow.PortRect.Top, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_RadarBackground)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_RadarBackground)).SourceRect, DDBLTFAST_WAIT
End If
End Sub
Sub RedrawControlPanel()
For I = 1 To Int(ResolutionX / Pics(InGameConstants(InGameConstant_PICINDEX_ControlPanelBackground)).Width)
  ControlPanelSurface.BltFast XPos, 0, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_ControlPanelBackground)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_ControlPanelBackground)).SourceRect, DDBLTFAST_WAIT
  XPos = XPos + Pics(InGameConstants(InGameConstant_PICINDEX_ControlPanelBackground)).Width
Next I
ControlPanelSurface.BltFast RadarButton.PortRect.Left, RadarButton.PortRect.Top - GameControlPanel.PortRect.Top, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_RadarButtonPic)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_RadarButtonPic)).SourceRect, DDBLTFAST_WAIT
Call RedrawBuildWindows
End Sub
Sub RedrawBuildWindows()
If Player(LocalPlayer.PlayerIndex).BuildClassesActive > 0 Then
  For I = 1 To MAXBUILDWINDOWS
    If Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).Active = True Then
      CurrentDisplayBuildClass = Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).ClassReference
      ControlPanelSurface.BltFast BuildWindows(I).PortRect.Left - GameControlPanel.PortRect.Left, BuildWindows(I).PortRect.Top - GameControlPanel.PortRect.Top, GraphicSurfaces(Pics(ObjModels(CurrentDisplayBuildClass).Attributes(ATTRIBUTE_BUILDPICTURE)).GraphicsLib), Pics(ObjModels(CurrentDisplayBuildClass).Attributes(ATTRIBUTE_BUILDPICTURE)).SourceRect, DDBLTFAST_WAIT
      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
            ControlPanelSurface.BltFast BuildWindows(I).PortRect.Left - GameControlPanel.PortRect.Left, BuildWindows(I).PortRect.Top - GameControlPanel.PortRect.Top, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_BuildReadyPic)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_BuildReadyPic)).SourceRect, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
            Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).Enabled = True
            Exit For
          End If
        
        End If
      Next I2
      If Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).Enabled = False Then
        ControlPanelSurface.BltFast BuildWindows(I).PortRect.Left - GameControlPanel.PortRect.Left, BuildWindows(I).PortRect.Top - GameControlPanel.PortRect.Top, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_BuildDisabledPic)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_BuildDisabledPic)).SourceRect, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
      End If
    End If
  Next I
End If
End Sub
Sub Render()
'Beta information
If GraphicsEngineData.TotalRefresh = True Then
  GraphicsEngineData.TotalRefresh = False
  Call RedrawControlPanel
  Call RenderTerrain
End If
Call DisplayControlPanel
Call RenderBattleView
Call RenderMoneyValue
For I = 1 To Internet.MaxMessages
  If Internet.InternetMessageBox.LinesActive(I) = True Then
    Call DisplayText(Internet.InternetMessageBox.TextLines(I), 12, 17 + ((I - 1) * FONT_SPACINGY), PALLETE_WHITE)
    MaxMessage = I
  End If
Next I
If InterfaceFlags.WritingAMessage = True Then
  Call DisplayText("say: " & InterfaceFlags.Message, 12, 17 + (MaxMessage * FONT_SPACINGY), 0)
End If
Call RenderRadar
If MessageWindow.Active = True Then Call DisplayMessageWindow
Call DrawCursor
Call SwapScreen
End Sub
Private Sub RenderTerrainBlock(GroundX, GroundY)
Dim BltType As Integer
If GroundX < 0 Then Exit Sub
If GroundY < 0 Then Exit Sub
DisplayX = GameInterface.ProjectXToView(Map.UnProjectToMapX(GroundX))
DisplayY = GameInterface.ProjectYToView(Map.UnProjectToMapY(GroundY)) '- GroundBlocks(GroundX, GroundY).Height
Call PutGraphicOntoTerrain(DisplayX, DisplayY, Sprites(GroundBlocks(GroundX, GroundY).SpriteNumbers(1)).SpriteGroups(GroundBlocks(GroundX, GroundY).DamageAmount + 1).Frames(GroundBlocks(GroundX, GroundY).AnimFrames(1)).PicNum, 0, BltType_Fast)
For I = 2 To GroundBlocks(GroundX, GroundY).TerrainOverlayAmount
  Call PutGraphicOntoTerrain(DisplayX, DisplayY, Sprites(GroundBlocks(GroundX, GroundY).SpriteNumbers(I)).SpriteGroups(GroundBlocks(GroundX, GroundY).DamageAmount + 1).Frames(GroundBlocks(GroundX, GroundY).AnimFrames(I)).PicNum, 0, BltType_Mask)
Next I
End Sub
Private Sub AnimTerrainBlock(GroundX, GroundY)
For I = 1 To GroundBlocks(GroundX, GroundY).TerrainOverlayAmount
  GroundBlocks(GroundX, GroundY).AnimFrames(I) = GroundBlocks(GroundX, GroundY).AnimFrames(I) + 1
  If GroundBlocks(GroundX, GroundY).AnimFrames(I) > Sprites(GroundBlocks(GroundX, GroundY).SpriteNumbers(I)).SpriteGroups(GroundBlocks(GroundX, GroundY).DamageAmount + 1).FrameMax Then
    GroundBlocks(GroundX, GroundY).AnimFrames(I) = 1
  End If
Next I
End Sub
Private Sub DrawStraightLine(X, Y, Distance, R, G, B, Direction)
X1 = X
Y1 = Y
RGBVAL = RGB(R, G, B)
SetPixelV lhdc, X1, Y1, RGBVAL
For I = 1 To Distance
  Select Case Direction
  Case DIRECTION_UP
    Y1 = Y1 - 1
  Case DIRECTION_DOWN
    Y1 = Y1 + 1
  Case DIRECTION_LEFT
    X1 = X1 - 1
  Case DIRECTION_RIGHT
    X1 = X1 + 1
  End Select
  SetPixelV lhdc, X1, Y1, RGBVAL
Next I
End Sub
Private Sub RenderSelectedBoxes()
BattleSurface.GetDC lhdc
'Selected object's outline
For I = 1 To GameInterface.ObjectSelectedList.IndexesActive
  With Objects(ObjectSelectedList.Indexes(I))
    spritewidth = Pics(Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).PicNum).Width
    spriteheight = Pics(Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).PicNum).Height
    OffX = ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONX)
    OffY = ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONY)
    CenterX = ProjectXToView(.Position.X)
    CenterY = ProjectYToView(.Position.Y)
    Call DrawStraightLine(CenterX - OffX, CenterY - OffY, 4, 150, 150, 150, DIRECTION_RIGHT)
    Call DrawStraightLine(CenterX - OffX, CenterY - OffY, 4, 150, 150, 150, DIRECTION_DOWN)
    
    Call DrawStraightLine((CenterX - OffX) + spritewidth, (CenterY - OffY) + spriteheight, 4, 150, 150, 150, DIRECTION_UP)
    Call DrawStraightLine((CenterX - OffX) + spritewidth, (CenterY - OffY) + spriteheight, 4, 150, 150, 150, DIRECTION_LEFT)
   
    Call DrawStraightLine(CenterX - OffX, (CenterY - OffY) + spriteheight, 4, 150, 150, 150, DIRECTION_UP)
    Call DrawStraightLine(CenterX - OffX, (CenterY - OffY) + spriteheight, 4, 150, 150, 150, DIRECTION_RIGHT)
    
    Call DrawStraightLine((CenterX - OffX) + spritewidth, CenterY - OffY, 4, 150, 150, 150, DIRECTION_DOWN)
    Call DrawStraightLine((CenterX - OffX) + spritewidth, CenterY - OffY, 4, 150, 150, 150, DIRECTION_LEFT)
   
   
    Call DrawBox((CenterX - OffX) + 5, CenterY - OffY - 1, ((CenterX - OffX) + spritewidth) - 5, CenterY - OffY + 1, 0, 100, 0, 0, 0, 0, LINEMODE_NORMAL)
    HealthBright = .Properties(PROPERTY_HEALTH) / (ObjModels(.ModelIndex).Attributes(ATTRIBUTE_HEALTH) / 255)
    Call DrawLine((CenterX - OffX) + 6, CenterY - OffY, ((CenterX - OffX) + spritewidth) - 6, CenterY - OffY, 0, 0, HealthBright, 0, 0, 0, LINEMODE_NORMAL)
  End With
Next I
BattleSurface.ReleaseDC lhdc
End Sub
Sub RenderInterface()

If InterfaceFlags.PlacingABuilding = True Then
    Dim TempPos As Point3D
    'For rendering the build option
    ModelNum = InterfaceFlags.PlaceIndex
    TempPos = Map.RoundToMap3DPoint(Mouse.Position)
    Call PutGraphicOntoBattleView(TempPos.X, TempPos.Y, SpriteStuff.Sprites(ObjModels(ModelNum).Attributes(ATTRIBUTE_SPRITE)).SpriteGroups(1).Frames(1).PicNum, 0, ObjModels(ModelNum).Attributes(ATTRIBUTE_SPRITEPOSITIONX), ObjModels(ModelNum).Attributes(ATTRIBUTE_SPRITEPOSITIONY))
End If

BattleSurface.GetDC lhdc
'Mouse-Box for selecting objects
If Mouse.IsDragging = True Then
  If Math.GetDistance(Mouse.DragCurrentPosition, Mouse.DragStartPosition) > 8 Then
    With Mouse.DragCurrentPosition
      FromX = .X - BattleViewPort.PortRect.Left
      FromY = .Y - BattleViewPort.PortRect.Top
      ToX = Mouse.DragStartPosition.X - BattleViewPort.PortRect.Left
      ToY = Mouse.DragStartPosition.Y - BattleViewPort.PortRect.Top
    End With
    With BattleViewPort
      If ToX > .Width - 1 Then ToX = .Width - 1
      If ToY > .Height - 1 Then ToY = .Height - 1
    End With
    If ToX - 4 < FromX Then
      If ToX + 4 > FromX Then
        If ToY - 4 < FromY Then
          If ToY + 4 > FromY Then
            DontDrawLine = True
          End If
        End If
      End If
    End If
    If DontDrawLine = False Then Call DrawBox(FromX, FromY, ToX, ToY, 255, 0, 0, 0, 0, 255, LINEMODE_SHADE)
  End If
End If
BattleSurface.ReleaseDC lhdc
End Sub
Sub RenderBattleView()
If GameEngine.View.ScrollSpeedEW = 0 Then
  If GameEngine.View.ScrollSpeedNS = 0 Then
    
    Call UpdateScenery
  End If
End If
BattleSurface.BltFast 0, 0, TerrainSurface, BattleSurfaceRect, 0
Call RenderObjects
Call RenderVisualEffects
Call RenderSelectedBoxes
Call RenderInterface
'puts the completed scene onto the backbuffer
ddsBack.BltFast BattleViewPort.PortRect.Left, BattleViewPort.PortRect.Top, BattleSurface, BattleSurfaceRect, DDBLTFAST_WAIT
End Sub
Sub RenderVisualEffects()
BattleSurface.GetDC lhdc

Call RenderSparkles
Call RenderSparks

BattleSurface.ReleaseDC lhdc

Call RenderAnimations
End Sub
Sub RenderObjects()
Dim EliminatedObjects(MAXOBJECTS) As Boolean, EntitiesToRender(MAXOBJECTS), RenderX(MAXOBJECTS), RenderY(MAXOBJECTS), Clips(MAXOBJECTS) As Boolean
BestRenderY = ResolutionY + 100
ClosestRenderY = -9999
For I = 1 To ObjectsActive
  RenderX(I) = ProjectXToView(Objects(I).Position.X)
  RenderY(I) = ProjectYToView(Objects(I).Position.Y) - (Objects(I).Position.Z / 3)
  If ObjModels(Objects(I).ModelIndex).ObjClassName = "TestBase" Then
     dsfsdf = 4
  End If
Next I
For I = 1 To ObjectsActive
  With Objects(I)
    If .Frozen = False Then
      If CheckObject(I, OBJCHECK_VISIBLE) = True Then
        Clips(I) = ClipPic(RenderX(I), RenderY(I), SpriteStuff.Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).PicNum, ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONX), ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONY))
      Else
        Clips(I) = True
      End If
    Else
      Clips(I) = True
    End If
  End With
Next I
For I2 = 1 To ObjectsActive
    If Clips(I2) = False Then
        ClosestRenderY = -9999
        ClosestRenderObj = NOOBJECT
        For I = 1 To ObjectsActive
          If EliminatedObjects(I) = False Then
            If CheckObject(I, OBJCHECK_ALIVE) = True Then
              If Clips(I) = False Then
                If RenderY(I) <= BestRenderY Then
                  If RenderY(I) >= ClosestRenderY Then
                    ClosestRenderY = RenderY(I)
                    ClosestRenderObj = I
                  End If
                End If
              End If
            End If
          End If
        Next I
        If ClosestRenderObj <> NOOBJECT Then
          EliminatedObjects(ClosestRenderObj) = True
          NextToRender = NextToRender + 1
          EntitiesToRender(NextToRender) = ClosestRenderObj