⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 maped.bas

📁 超级C&C有没有搞错,VB还能编出这种即时策略游戏来!没错,这就是我们的超级C&C!虽然游戏经常无故退出,但是原码仍有很多可圈可点的地方.祝你早日编出中国的超级RA,超级KKND,超级星际,超级家园
💻 BAS
字号:
🔍 
Attribute VB_Name = "MapEdit"
Global TerrMoveMethod As Integer
Global CurrTerrain As Integer
Global Const shadowline = 1.5
Global Const DivVal1 = 2
Global Const BlockSize = 20
Global Const HalfBlockSize = (BlockSize / 4) * 3
Global DropItem As Boolean

Global MaxX As Integer
Global MaxY As Integer
Type GrndBlcks
  TerrainType As Integer
  Z(4) As Integer
End Type
Global GroundBlocks(100, 100) As GrndBlcks
Global ViewX As Single
Global ViewY As Single
Global Const ViewWidth = 20
Global Const ViewHeight = 20
Global Const HalfViewWidth = ViewWidth / 2
Global Const TERR_GRASS = 0
Global Const TERR_WATER = 1
Global Const TERR_GOLD = 2
Global Const TERR_COASTLINE = 3
Global Const TERRAINTYPE_ROCKS = 4
Public Function GetPropertyValue(TextString) As String
GetPropertyValue = Right$(TextString, Len(TextString) - InStr(1, TextString, " "))
End Function
Public Function GetPropertyName(TextString) As String
If InStr(1, TextString, " ") = 0 Then
  GetPropertyName = TextString
Else
  GetPropertyName = Left$(TextString, InStr(1, TextString, " ") - 1)
End If
End Function
Sub GenItem(ItemName, X, Y)
CX = Int((X / BlockSize) + ViewX)
Cy = Int((Y / HalfBlockSize) + ViewY)
Form1.Picture1.Circle (((CX - ViewX) * BlockSize) + (BlockSize / 2), ((Cy - ViewY) * HalfBlockSize) + (HalfBlockSize / 2)), 7, RGB(255, 255, 0)
Form1.Picture1.CurrentX = ((CX - ViewX) * BlockSize) + (BlockSize / 2)
Form1.Picture1.CurrentY = ((Cy - ViewY) * HalfBlockSize) + (HalfBlockSize / 2)
Form1.Picture1.ForeColor = RGB(255, 0, 0)
Form1.Picture1.Print ItemName
End Sub
Sub LoadMap(EpisodeNumber, LevelNumber)
Open "E" & EpisodeNumber & "L" & LevelNumber & ".Ter" For Input As #1

        Line Input #1, a$ 'Map width
        Form1.Text1.Text = Val(GetPropertyValue(a$))
        
        Line Input #1, a$ 'Map height
        Form1.Text2.Text = Val(GetPropertyValue(a$))
MaxX = Val(Form1.Text1.Text)
Form1.HScroll1.Max = (MaxX - ViewWidth) * 4
MaxY = Val(Form1.Text2.Text)
Form1.VScroll1.Max = (MaxY - ViewHeight) * 4
        
        For X = 1 To MaxX
          For Y = 1 To MaxY
            Line Input #1, a$
            GroundBlocks(X, Y).TerrainType = Val(GetPropertyValue(a$))
            Line Input #1, a$
            GroundBlocks(X, Y).Z(1) = Val(GetPropertyValue(a$))
            Line Input #1, a$
            GroundBlocks(X, Y).Z(2) = Val(GetPropertyValue(a$))
            Line Input #1, a$
            GroundBlocks(X, Y).Z(3) = Val(GetPropertyValue(a$))
            Line Input #1, a$
            GroundBlocks(X, Y).Z(4) = Val(GetPropertyValue(a$))
          Next Y
        Next X

Close #1
End Sub

Sub SaveMap(EpisodeNumber, LevelNumber)
Open "E" & EpisodeNumber & "L" & LevelNumber & ".Ter" For Output As #1
  Print #1, MaxX
  Print #1, MaxY
        For X = 1 To MaxX
          For Y = 1 To MaxY
            Print #1, GroundBlocks(X, Y).TerrainType
            
            For i = 1 To 4
              Print #1, GroundBlocks(X, Y).Z(i)
            Next i
          Next Y
        Next X

Close #1
End Sub
Sub RenderView()
'Form1.Picture1.Cls
    OffsetX = (ViewX * BlockSize)
    offsetY = (ViewY * HalfBlockSize) - 1

For currX = Int(ViewX) To Int(ViewX) + ViewWidth
  For currY = Int(ViewY) To Int(ViewY) + ViewHeight
    Select Case GroundBlocks(currX, currY).TerrainType
    Case TERR_GRASS
      rc = 1
      gc = 255
      bc = 1
    Case TERR_WATER
      rc = 1
      gc = 100
      bc = 255
    Case TERR_GOLD
      rc = 200
      gc = 200
      bc = 1
    Case TERR_COASTLINE
      rc = 1
      gc = 200
      bc = 200
    
    End Select
    
    Form1.Picture1.Line ((currX * BlockSize) - OffsetX, (currY * HalfBlockSize) - offsetY)-(((currX + 1) * BlockSize) - OffsetX, ((currY + 1) * HalfBlockSize) - offsetY), RGB(rc / 3, gc / 3, bc / 3), BF
  Next currY
Next currX
OffZ = 5
FromX = Int(ViewX)
FromY = Int(ViewY)
ToX = Int(ViewX) + ViewWidth
ToY = Int(ViewY) + ViewHeight
For X = FromX To ToX 'ViewX To ViewX + ViewWidth
  For Y = FromY To ToY 'ViewY To ViewY + ViewHeight
    Select Case GroundBlocks(X, Y).TerrainType
    Case TERR_GRASS
      rc = 1
      gc = 255
      bc = 1
    Case TERR_WATER
      rc = 1
      gc = 100
      bc = 255
    Case TERR_GOLD
      rc = 200
      gc = 200
      bc = 1
    Case TERR_COASTLINE
      rc = 1
      gc = 200
      bc = 200

    End Select
    OffX = ViewX * BlockSize
    OffY = ViewY * HalfBlockSize
    Ind = 1
    DisplaceX = ((X - ViewX) - (HalfViewWidth)) * ((GroundBlocks(X, Y).Z(1) + OffZ) / 4)
    DisplaceX2 = (((X + 1) - ViewX) - (HalfViewWidth)) * ((GroundBlocks(X + 1, Y).Z(1) + OffZ) / 4)
    Form1.Picture1.Line (((X * BlockSize) + DisplaceX) - OffX, ((Y * HalfBlockSize) - (GroundBlocks(X, Y).Z(1) * 2)) - OffY)-((X * BlockSize) - OffsetX, (Y * HalfBlockSize) - offsetY), RGB(rc / shadowline, gc / shadowline, bc / shadowline)
    
    Form1.Picture1.Line (((X * BlockSize) + DisplaceX) - OffX, ((Y * HalfBlockSize) - (GroundBlocks(X, Y).Z(1) * 2)) - OffY)-((((X + 1) * BlockSize) + DisplaceX2) - OffX, ((Y * HalfBlockSize) - (GroundBlocks(X, Y).Z(2) * 2)) - OffY), RGB(rc, gc, bc)
    
    
    Ind = 2
    DisplaceX = ((X - ViewX) - (HalfViewWidth)) * ((GroundBlocks(X, Y).Z(1) + OffZ) / 4)
    DisplaceX2 = ((X - ViewX) - (HalfViewWidth)) * ((GroundBlocks(X, Y + 1).Z(1) + OffZ) / 4)
    
    Form1.Picture1.Line (((X * BlockSize) + DisplaceX) - OffX, ((Y * HalfBlockSize) - (GroundBlocks(X, Y).Z(1) * 2)) - OffY)-(((X * BlockSize) + DisplaceX2) - OffX, (((Y + 1) * HalfBlockSize) - (GroundBlocks(X, Y).Z(4) * 2)) - OffY), RGB(rc, gc, bc)
    
    
    
  Next Y
Next X
End Sub
Sub DrawSquare(X1, Y1)
X = X1
Y = Y1
OAmnt = 3
OAmnt2 = 4
OffsetX = (ViewX * BlockSize)
offsetY = (ViewY * HalfBlockSize) - 1
If X < 1 + OAmnt Then X = OAmnt + 1
If Y < 1 + OAmnt Then Y = OAmnt + 1
For currX = X - OAmnt To X + OAmnt
  For currY = Y - OAmnt To Y + OAmnt
    Select Case GroundBlocks(currX, currY).TerrainType
    Case TERR_GRASS
      rc = 1
      gc = 255
      bc = 1
    Case TERR_WATER
      rc = 1
      gc = 100
      bc = 255
    Case TERR_GOLD
      rc = 200
      gc = 200
      bc = 1
    Case TERR_COASTLINE
      rc = 1
      gc = 200
      bc = 200
    
    End Select
    
    Form1.Picture1.Line ((currX * BlockSize) - OffsetX, (currY * HalfBlockSize) - offsetY)-(((currX + 1) * BlockSize) - OffsetX, ((currY + 1) * HalfBlockSize) - offsetY), RGB(rc / 3, gc / 3, bc / 3), BF
  Next currY
Next currX
OffZ = 5
FromX = X - OAmnt2
FromY = Y - OAmnt2
If FromY < 1 Then FromY = 1
If FromX < 1 Then FromX = 1
ToX = X + OAmnt2
ToY = Y + OAmnt2
For X = FromX To ToX 'ViewX To ViewX + ViewWidth
  For Y = FromY To ToY 'ViewY To ViewY + ViewHeight
    Select Case GroundBlocks(X, Y).TerrainType
    Case TERR_GRASS
      rc = 1
      gc = 255
      bc = 1
    Case TERR_WATER
      rc = 1
      gc = 100
      bc = 255
    Case TERR_GOLD
      rc = 200
      gc = 200
      bc = 1
    Case TERR_COASTLINE
      rc = 1
      gc = 200
      bc = 200
    
    End Select
    OffX = ViewX * BlockSize
    OffY = ViewY * HalfBlockSize
    Ind = 1
    DisplaceX = ((X - ViewX) - (HalfViewWidth)) * ((GroundBlocks(X, Y).Z(1) + OffZ) / 4)
    DisplaceX2 = (((X + 1) - ViewX) - (HalfViewWidth)) * ((GroundBlocks(X + 1, Y).Z(1) + OffZ) / 4)
    Form1.Picture1.Line (((X * BlockSize) + DisplaceX) - OffX, ((Y * HalfBlockSize) - (GroundBlocks(X, Y).Z(1) * 2)) - OffY)-((X * BlockSize) - OffsetX, (Y * HalfBlockSize) - offsetY), RGB(rc / shadowline, gc / shadowline, bc / shadowline)
    
    Form1.Picture1.Line (((X * BlockSize) + DisplaceX) - OffX, ((Y * HalfBlockSize) - (GroundBlocks(X, Y).Z(1) * 2)) - OffY)-((((X + 1) * BlockSize) + DisplaceX2) - OffX, ((Y * HalfBlockSize) - (GroundBlocks(X, Y).Z(2) * 2)) - OffY), RGB(rc, gc, bc)
    
    
    Ind = 2
    DisplaceX = ((X - ViewX) - (HalfViewWidth)) * ((GroundBlocks(X, Y).Z(1) + OffZ) / 4)
    DisplaceX2 = ((X - ViewX) - (HalfViewWidth)) * ((GroundBlocks(X, Y + 1).Z(1) + OffZ) / 4)
    
    Form1.Picture1.Line (((X * BlockSize) + DisplaceX) - OffX, ((Y * HalfBlockSize) - (GroundBlocks(X, Y).Z(1) * 2)) - OffY)-(((X * BlockSize) + DisplaceX2) - OffX, (((Y + 1) * HalfBlockSize) - (GroundBlocks(X, Y).Z(4) * 2)) - OffY), RGB(rc, gc, bc)
    
    
    
    
  Next Y
Next X

End Sub
Sub ChangeHeight(X, Y, NewZ)
GroundBlocks(X, Y).Z(1) = NewZ
GroundBlocks(X - 1, Y - 1).Z(3) = NewZ
GroundBlocks(X - 1, Y).Z(2) = NewZ
GroundBlocks(X, Y - 1).Z(4) = NewZ
End Sub
Sub DropGroundType(X, Y)
CX = Int((X / BlockSize) + ViewX)
Cy = Int((Y / HalfBlockSize) + ViewY)
If CX < 1 Then CX = 1
If Cy < 1 Then Cy = 1
GroundBlocks(CX, Cy).TerrainType = CurrTerrain
Call ScanMap4Coast
If CurrTerrain = 1 Then Call Terrainmove(X, Y, 4)
Call DrawSquare(CX, Cy)
End Sub
Sub Terrainmove(X, Y, TerrMeth)
CX = Int((X / BlockSize) + ViewX)
Cy = Int((Y / HalfBlockSize) + ViewY)
NormZ = (GroundBlocks(CX, Cy).Z(1) + GroundBlocks(CX, Cy).Z(2) + GroundBlocks(CX, Cy).Z(3) + GroundBlocks(CX, Cy).Z(4)) / 4
Select Case TerrMeth
Case 0
NormZ = NormZ + 3
For i = 1 To 4
  GroundBlocks(CX, Cy).Z(i) = NormZ + (Int(4 * Rnd) - 2)
  If GroundBlocks(CX, Cy).Z(i) < 0 Then GroundBlocks(CX, Cy).Z(i) = 0
Next i

Case 1
NormZ = NormZ - 3
For i = 1 To 4
  GroundBlocks(CX, Cy).Z(i) = NormZ + (Int(4 * Rnd) - 2)
  If GroundBlocks(CX, Cy).Z(i) < 0 Then GroundBlocks(CX, Cy).Z(i) = 0
Next i

Case 2

For i = 1 To 4
  GroundBlocks(CX, Cy).Z(i) = NormZ
  If GroundBlocks(CX, Cy).Z(i) < 0 Then GroundBlocks(CX, Cy).Z(i) = 0
Next i
Case 4
For i = 1 To 4
  GroundBlocks(CX, Cy).Z(i) = 0
Next i

End Select

GroundBlocks(CX - 1, Cy).Z(2) = GroundBlocks(CX, Cy).Z(1)
GroundBlocks(CX - 1, Cy).Z(3) = GroundBlocks(CX, Cy).Z(4)
GroundBlocks(CX, Cy - 1).Z(3) = GroundBlocks(CX, Cy).Z(2)
GroundBlocks(CX, Cy - 1).Z(4) = GroundBlocks(CX, Cy).Z(1)

GroundBlocks(CX + 1, Cy).Z(4) = GroundBlocks(CX, Cy).Z(3)
GroundBlocks(CX + 1, Cy).Z(1) = GroundBlocks(CX, Cy).Z(2)
GroundBlocks(CX, Cy + 1).Z(1) = GroundBlocks(CX, Cy).Z(4)
GroundBlocks(CX, Cy + 1).Z(2) = GroundBlocks(CX, Cy).Z(3)

GroundBlocks(CX - 1, Cy - 1).Z(3) = GroundBlocks(CX, Cy).Z(1)
GroundBlocks(CX + 1, Cy - 1).Z(4) = GroundBlocks(CX, Cy).Z(2)
GroundBlocks(CX - 1, Cy + 1).Z(2) = GroundBlocks(CX, Cy).Z(4)
GroundBlocks(CX + 1, Cy + 1).Z(1) = GroundBlocks(CX, Cy).Z(3)

Call DrawSquare(CX, Cy)
End Sub
Sub ScanMap4Coast()
For X = 1 To MaxX
  For Y = 1 To MaxY
    If GroundBlocks(X, Y).TerrainType = TERR_COASTLINE Then
      GroundBlocks(X, Y).TerrainType = TERR_GRASS
    End If
  Next Y
Next X
For X = 1 To MaxX
  For Y = 1 To MaxY
    If GroundBlocks(X, Y).TerrainType = TERR_GRASS Then
      If GroundBlocks(X - 1, Y).TerrainType = TERR_WATER Then
        GroundBlocks(X, Y).TerrainType = TERR_COASTLINE
      End If
      If GroundBlocks(X + 1, Y).TerrainType = TERR_WATER Then
        GroundBlocks(X, Y).TerrainType = TERR_COASTLINE
      End If
      If GroundBlocks(X, Y - 1).TerrainType = TERR_WATER Then
        GroundBlocks(X, Y).TerrainType = TERR_COASTLINE
      End If
      If GroundBlocks(X, Y + 1).TerrainType = TERR_WATER Then
        GroundBlocks(X, Y).TerrainType = TERR_COASTLINE
      End If
    End If
  Next Y
Next X
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -