map.bas

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

Next X
End Sub
Sub LoadMap(MapFile)
End Sub
Public Function IsImprintSpaceNonGrass(X, Y, ImprintIndex) As Boolean
On Error Resume Next
PosX = X - HALFIMPRINTSIZE
PosY = Y - HALFIMPRINTSIZE
For X1 = 1 To IMPRINTSIZE
  For Y1 = 1 To IMPRINTSIZE
    If MapImprints(ObjModels(ClassNum).Attributes(ATTRIBUTE_MAPIMPRINT)).ImprintArray(X1, Y1) = True Then
      If GroundBlocks(PosX + X1, PosY + Y1).TerrainType <> TERRAINTYPE_GRASS Then
        IsImprintSpaceNonGrass = True
        Exit Function
      End If
    End If
  Next Y1
Next X1
End Function
Public Function IsImprintSpaceOccupied(X, Y, ImprintIndex) As Boolean
On Error Resume Next
For X1 = 1 To IMPRINTSIZE
  For Y1 = 1 To IMPRINTSIZE
    If MapImprints(ObjModels(ClassNum).Attributes(ATTRIBUTE_MAPIMPRINT)).ImprintArray(X1, Y1) = True Then
      If GroundBlocks((X - HALFIMPRINTSIZE) + X1, (Y - HALFIMPRINTSIZE) + Y1).Occupied = True Then
        IsImprintSpaceOccupied = True
        Exit Function
      End If
    End If
  Next Y1
Next X1
End Function
Public Sub PlaceMapImprint(ImprintIndex, X, Y, ObjIndex)
On Error Resume Next
Putx = X - HALFIMPRINTSIZE
Puty = Y - HALFIMPRINTSIZE
For ImprintScanX = 1 To IMPRINTSIZE
  For imprintscany = 1 To IMPRINTSIZE
    If MapImprints(ImprintIndex).ImprintArray(ImprintScanX, imprintscany) = True Then
      GroundBlocks(ImprintScanX + Putx, imprintscany + Puty).OccupyingObject = ObjIndex
      GroundBlocks(ImprintScanX + Putx, imprintscany + Puty).Occupied = True
    End If
  Next imprintscany
Next ImprintScanX
End Sub
Public Sub LiftMapImprint(MapX, MapY, ObjIndex)
On Error Resume Next
OffX = MapX - HALFIMPRINTSIZE
OffY = MapY - HALFIMPRINTSIZE
For X = 1 To IMPRINTSIZE
  For Y = 1 To IMPRINTSIZE
    If GroundBlocks(X + OffX, Y + OffY).OccupyingObject = ObjIndex Then
      GroundBlocks(X + OffX, Y + OffY).Occupied = False
    End If
  Next Y
Next X
End Sub
Public Function ProjectToMapX(mX) As Integer
ProjectToMapX = Int(mX / MapBlockSize)
End Function
Public Function ProjectToMapY(mY) As Integer
ProjectToMapY = Int(mY / MapBlockSize)
End Function
Public Function UnProjectToMapX(mX) As Integer
UnProjectToMapX = (mX * MapBlockSize) + (HalfMapBlockSize - 1)
End Function
Public Function UnProjectToMapY(mY) As Integer
UnProjectToMapY = (mY * MapBlockSize) + (HalfMapBlockSize - 1)
End Function
Public Function UnProjectToMap3DPoint(OrigPoint As Point3D) As Point3D
UnProjectToMap3DPoint.X = Map.UnProjectToMapX(OrigPoint.X)
UnProjectToMap3DPoint.Y = Map.UnProjectToMapY(OrigPoint.Y)
UnProjectToMap3DPoint.Z = OrigPoint.Z
End Function
Public Function RoundToMap3DPoint(OrigPoint As Point3D) As Point3D
RoundToMap3DPoint.X = Map.ProjectToMapX(OrigPoint.X)
RoundToMap3DPoint.X = Map.UnProjectToMapX(RoundToMap3DPoint.X)
RoundToMap3DPoint.Y = Map.ProjectToMapY(OrigPoint.Y)
RoundToMap3DPoint.Y = Map.UnProjectToMapY(RoundToMap3DPoint.Y)
RoundToMap3DPoint.Z = OrigPoint.Z
End Function
Public Function ProjectToMap3DPoint(OrigPoint As Point3D) As Point3D
ProjectToMap3DPoint.X = Map.ProjectToMapX(OrigPoint.X)
ProjectToMap3DPoint.Y = Map.ProjectToMapY(OrigPoint.Y)
ProjectToMap3DPoint.Z = OrigPoint.Z
End Function
Public Function SetGroundUnOccupiedByObject(ObjIndex) As Boolean
If ObjModels(Objects(ObjIndex).ModelIndex).Attributes(ATTRIBUTE_MAPIMPRINT) = NOMAPIMPRINT Then
  X = Objects(ObjIndex).MapPosition.X
  Y = Objects(ObjIndex).MapPosition.Y
  Size = ObjModels(Objects(ObjIndex).ModelIndex).Attributes(ATTRIBUTE_SIZE)
  For Xplace = X - Int(Size / 2) To X + Int(Size / 2)
    For Yplace = Y - Int(Size / 2) To Y + Int(Size / 2)
      GroundBlocks(Xplace, Yplace).Occupied = False
    Next Yplace
  Next Xplace
Else
  Call LiftMapImprint(X, Y, ObjIndex)
End If
End Function
Public Function SetGroundOccupiedByObject(ObjIndex) As Boolean
If ObjModels(Objects(ObjIndex).ModelIndex).Attributes(ATTRIBUTE_MAPIMPRINT) = NOMAPIMPRINT Then
  X = Objects(ObjIndex).MapPosition.X
  Y = Objects(ObjIndex).MapPosition.Y
  Size = ObjModels(Objects(ObjIndex).ModelIndex).Attributes(ATTRIBUTE_SIZE)
  For Xplace = X - Int(Size / 2) To X + Int(Size / 2)
    For Yplace = Y - Int(Size / 2) To Y + Int(Size / 2)
      GroundBlocks(Xplace, Yplace).Occupied = True
      GroundBlocks(Xplace, Yplace).OccupyingObject = ObjIndex
    Next Yplace
  Next Xplace
Else
  Call PlaceMapImprint(ObjModels(Objects(ObjIndex).ModelIndex).Attributes(ATTRIBUTE_MAPIMPRINT), X, Y, ObjIndex)
End If
End Function
Public Function GetGroundOccupied(X, Y, Size) As Boolean
  For Xplace = X - Int(Size / 2) To X + Int(Size / 2)
    For Yplace = Y - Int(Size / 2) To Y + Int(Size / 2)
      If GroundBlocks(Xplace, Yplace).Occupied = True Then
        GetGroundOccupied = True
        Exit Function
      End If
    Next Yplace
  Next Xplace
End Function
Public Function IsMapBlockEmpty(P3D As Point3D) As Boolean
If GroundBlocks(P3D.X, P3D.Y).Occupied = False Then IsMapBlockEmpty = True
End Function
Public Function IsMapBlockEmptyXY(X, Y) As Boolean
If GroundBlocks(X, Y).Occupied = False Then IsMapBlockEmptyXY = True
End Function
Public Function GetNearestEmptyBlock(X, Y, OffLimitsTerrain, ConsiderDestinations As Boolean) As Point3D
'Searches in a clock-wise manner for an empty terrain block

If GroundBlocks(X, Y).Occupied = False Then
  If GroundBlocks(X, Y).TerrainType <> OffLimitsTerrain Then
    'Checks if any objects are going to that spot already
    If ConsiderDestinations = True Then
      For I = 1 To ObjectsActive
        If Entities.CheckObject(I, OBJCHECK_ALIVE) = True Then
          If Objects(I).Objective.MainDestination.X = X Then
            If Objects(I).Objective.MainDestination.Y = Y Then
              Occupied = True
            End If
          End If
        End If
      Next I
      If Occupied = False Then
        GetNearestEmptyBlock.X = X
        GetNearestEmptyBlock.Y = Y
        Exit Function
      End If
    Else
      GetNearestEmptyBlock.X = X
      GetNearestEmptyBlock.Y = Y
      Exit Function
    End If
  End If
End If
ScanSide = 1
ScanLine = 1
MaxScan = 1
ScanY = MaxScan
ScanX = -MaxScan
Do
  Count = Count + 1
  If Count > 400 Then
    ScanX = 0
    ScanY = 0
    Exit Do
  End If
  Occupied = False
  CurrentX = X + ScanX
  CurrentY = Y + ScanY
  If CurrentX < 0 Then CurrentX = 0
  If CurrentY < 0 Then CurrentY = 0
  If CurrentX > BattleMap.Width Then CurrentX = BattleMap.Width
  If CurrentY > BattleMap.Height Then CurrentY = BattleMap.Height
  
  If GroundBlocks(CurrentX, CurrentY).Occupied = True Then
    Occupied = True
  Else
    If GroundBlocks(CurrentX, CurrentY).TerrainType = OffLimitsTerrain Then
      Occupied = True
    Else
      'Checks if any objects are going to that spot already
      If ConsiderDestinations = True Then
        For I = 1 To ObjectsActive
          If Entities.CheckObject(I, OBJCHECK_ALIVE) = True Then
            If Objects(I).Objective.MainDestination.X = CurrentX Then
              If Objects(I).Objective.MainDestination.Y = CurrentY Then
                Occupied = True
              End If
            End If
          End If
        Next I
      End If
    End If
  End If
  If Occupied = True Then
    If ScanSide = 1 Then
      If ScanLine = 1 Then
        ScanY = ScanY - 1
        If ScanY = -MaxScan Then
          ScanLine = 2
        End If
      Else
        ScanX = ScanX + 1
        If ScanX = MaxScan Then
          ScanSide = 2
        End If
      End If
    Else
      If ScanLine = 2 Then
        ScanY = ScanY + 1
        If ScanY = MaxScan Then
          ScanLine = 1
        End If
      Else
        ScanX = ScanX - 1
        If ScanX = -MaxScan Then
          ScanSide = 1
          ScanX = ScanX - 1
          ScanY = ScanY + 1
          MaxScan = MaxScan + 1
        End If
      End If
    End If
  Else
    Exit Do  'Free square found!
  End If
Loop
GetNearestEmptyBlock.X = X + ScanX
GetNearestEmptyBlock.Y = Y + ScanY
End Function