?? module1.bas
字號:
Attribute VB_Name = "Module1"
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Const SRCAND = &H8800C6
Public Const SRCPAINT = &HEE0086
Public Const SRCCOPY = &HCC0020
Public Const MAPROWS = 28
Public Const MAPCOLS = 24
Public Type TILE
StructureID As Integer
EarthTile As Integer
LandValue As Long
Population As Long
Growth As Integer
ColorFlag As Integer
Name As String * 20
ClassFlag As Integer
End Type: Public T(0 To MAPROWS, 0 To MAPCOLS) As TILE, Cash As Long
'Selection Memory
Public Type MOUSESTAT
selectedPurchase As Integer
price As Long
End Type: Public MS As MOUSESTAT
'Date system
Public CurrentSeason As Integer, CurMonth As Integer, CurYear As Integer
'Mechanix Vars (for loops, mouse, stats, ect...)
Public CURS As Integer, CURC As Integer, CURL As Integer, MouseOUT As Boolean
Public TotalPOP As Long, SafetyCount As Integer, rn As Integer, rn2 As Integer, Crime As Integer
Public i As Integer, ii As Integer, iii As Integer, iiii As Integer, Drawing As Boolean
Public CX As Single, CY As Single, NX As Integer, NY As Integer, NX1 As Integer, NY1 As Integer, NX2 As Integer, NY2 As Integer, W As Integer, H As Integer
Sub filesave()
Open App.Path & "\save.bin" For Binary As #1
Put #1, , Cash
Put #1, , CurrentSeason
Put #1, , CurYear
Put #1, , CurMonth
For i = 0 To MAPROWS
For ii = 0 To MAPCOLS
Put #1, , T(i, ii)
Next
Next
Close #1
End Sub
Sub fileload()
Open App.Path & "\save.bin" For Binary As #1
Get #1, , Cash
Get #1, , CurrentSeason
Get #1, , CurYear
Get #1, , CurMonth
For i = 0 To MAPROWS
For ii = 0 To MAPCOLS
Get #1, , T(i, ii)
Next
Next
Close #1
End Sub
Public Function RndRange(ByVal intMin As Integer, ByVal intMax As Integer) As Integer
RndRange = Int(Rnd * (intMax - intMin + 1)) + intMin
End Function
Sub initTILES() 'Sets Default Tile Values
For i = 0 To MAPROWS
For ii = 0 To MAPCOLS
T(i, ii).StructureID = 100
T(i, ii).EarthTile = Rnd * 8
T(i, ii).LandValue = 100
T(i, ii).Population = 0
T(i, ii).Growth = 0
T(i, ii).ColorFlag = 0
T(i, ii).Name = "Open Space"
Next
Next
CurrentSeason = 1
Cash = 1000000
CurMonth = 1
CurYear = 1900
End Sub
Function ReturnMstr(inte As Integer) As String
'Returns Month + Changes Seasons
Select Case inte 'Process input
Case 1: ReturnMstr = "JAN": CurrentSeason = 1
Case 2: ReturnMstr = "FEB": CurrentSeason = 1
Case 3: ReturnMstr = "MAR": CurrentSeason = 1
Case 4: ReturnMstr = "APR": CurrentSeason = 2
Case 5: ReturnMstr = "MAY": CurrentSeason = 2
Case 6: ReturnMstr = "JUNE": CurrentSeason = 3
Case 7: ReturnMstr = "JULY": CurrentSeason = 3
Case 8: ReturnMstr = "AUG": CurrentSeason = 3
Case 9: ReturnMstr = "SEP": CurrentSeason = 3
Case 10: ReturnMstr = "OCT": CurrentSeason = 4
Case 11: ReturnMstr = "NOV": CurrentSeason = 4
Case 12: ReturnMstr = "DEC": CurrentSeason = 1
End Select
End Function
Sub DrawBacks() 'Draw Turf backgrounds.
For i = 0 To MAPROWS
For ii = 0 To MAPCOLS
BitBlt GFX.Turf(1).hDC, i * 13, ii * 13, 13, 13, Form1.TURFWinter(T(i, ii).EarthTile).hDC, 0, 0, SRCCOPY
BitBlt GFX.Turf(2).hDC, i * 13, ii * 13, 13, 13, Form1.TURFSpring(T(i, ii).EarthTile).hDC, 0, 0, SRCCOPY
BitBlt GFX.Turf(3).hDC, i * 13, ii * 13, 13, 13, Form1.TURFSummer(T(i, ii).EarthTile).hDC, 0, 0, SRCCOPY
BitBlt GFX.Turf(4).hDC, i * 13, ii * 13, 13, 13, Form1.TURFFall(T(i, ii).EarthTile).hDC, 0, 0, SRCCOPY
Next
Next
End Sub
Sub DrawBoard() 'Draw Structures Sprite
Drawing = True
On Error Resume Next
For i = 0 To MAPROWS
For ii = 0 To MAPCOLS
Select Case T(i, ii).StructureID
Case 0
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.h1M.hDC, 0, 0, SRCCOPY
Select Case T(i, ii).ColorFlag
Case 0: BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.h1Sbr.hDC, 0, 0, SRCCOPY
Case 1: BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.h1SMon.hDC, 0, 0, SRCCOPY
Case 2: BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.h1Sgr.hDC, 0, 0, SRCCOPY
End Select
Case 1
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 13, GFX.Picture1.hDC, 0, 0, SRCCOPY
Select Case T(i, ii).ColorFlag
Case 0: BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 13, GFX.h2Sbr.hDC, 0, 0, SRCCOPY
Case 1: BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 13, GFX.h2SMon.hDC, 0, 0, SRCCOPY
Case 2: BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 13, GFX.h2Sgr.hDC, 0, 0, SRCCOPY
End Select
Case 2
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.c1M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.c1S.hDC, 0, 0, SRCCOPY
Case 3
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.c2M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.c2S.hDC, 0, 0, SRCCOPY
Case 4
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.c3M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.c3S.hDC, 0, 0, SRCCOPY
Case 5
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.c4M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.c4S.hDC, 0, 0, SRCCOPY
Case 6
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.i1M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.i1S.hDC, 0, 0, SRCCOPY
Case 7
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.i2M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.i2S.hDC, 0, 0, SRCCOPY
Case 8
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.i3M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.i3S.hDC, 0, 0, SRCCOPY
Case 9
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.i4M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.i4S.hDC, 0, 0, SRCCOPY
Case 10
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rT4M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rT4s.hDC, 0, 0, SRCCOPY
Case 11
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rT1M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rT1s.hDC, 0, 0, SRCCOPY
Case 12
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rC3M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rC3s.hDC, 0, 0, SRCCOPY
Case 13
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rC4M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rC4s.hDC, 0, 0, SRCCOPY
Case 14
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rLRM.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rLRs.hDC, 0, 0, SRCCOPY
Case 15
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rT2M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rT2s.hDC, 0, 0, SRCCOPY
Case 16
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rT3M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rT3s.hDC, 0, 0, SRCCOPY
Case 17
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rC1M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rC1s.hDC, 0, 0, SRCCOPY
Case 18
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rC2M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rC2s.hDC, 0, 0, SRCCOPY
Case 19
BitBlt Form1.BGPB2.hDC, i * 13, ii * 13, 13, 14, GFX.rUDM.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13, ii * 13, 13, 14, GFX.rUDs.hDC, 0, 0, SRCCOPY
Case 20
BitBlt Form1.BGPB2.hDC, i * 13 - 3, ii * 13 - 3, 26, 16, GFX.RoadIm.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, i * 13 - 3, ii * 13 - 3, 26, 16, GFX.RoadIs.hDC, 0, 0, SRCCOPY
Select Case T(i - 1, ii).StructureID
Case 10
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rT4M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rT4s.hDC, 0, 0, SRCCOPY
Case 11
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rT1M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rT1s.hDC, 0, 0, SRCCOPY
Case 12
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rC3M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rC3s.hDC, 0, 0, SRCCOPY
Case 13
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rC4M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rC4s.hDC, 0, 0, SRCCOPY
Case 14
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rLRM.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rLRs.hDC, 0, 0, SRCCOPY
Case 15
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rT2M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rT2s.hDC, 0, 0, SRCCOPY
Case 16
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rT3M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rT3s.hDC, 0, 0, SRCCOPY
Case 17
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rC1M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rC1s.hDC, 0, 0, SRCCOPY
Case 18
BitBlt Form1.BGPB2.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rC2M.hDC, 0, 0, SRCCOPY
BitBlt Form1.BGPB.hDC, (i - 1) * 13, ii * 13, 13, 14, GFX.rC2s.hDC, 0, 0, SRCCOPY
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -