form1.frm

这是基于vb编写的一个虚拟城市的游戏程序,让读者能了解到游戏编程的乐趣.

         Left            =   120
         TabIndex        =   64
         Top             =   300
         Width           =   810
      End
   End
   Begin VB.PictureBox pbSCREEN 
      BackColor       =   &H00FFFFFF&
      Height          =   4935
      Left            =   120
      ScaleHeight     =   325
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   377
      TabIndex        =   0
      Top             =   120
      Width           =   5710
   End
   Begin VB.PictureBox BGPB2 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   4935
      Left            =   120
      ScaleHeight     =   325
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   377
      TabIndex        =   128
      Top             =   120
      Width           =   5710
   End
   Begin VB.PictureBox BGPB 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00000000&
      Height          =   4935
      Left            =   120
      ScaleHeight     =   325
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   377
      TabIndex        =   88
      Top             =   120
      Visible         =   0   'False
      Width           =   5710
   End
   Begin VB.PictureBox Buffer2 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   4935
      Left            =   120
      ScaleHeight     =   325
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   377
      TabIndex        =   116
      Top             =   120
      Visible         =   0   'False
      Width           =   5710
   End
   Begin VB.Label lblINCOME2 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "-"
      ForeColor       =   &H00808080&
      Height          =   255
      Left            =   5880
      TabIndex        =   103
      Top             =   3840
      Width           =   2145
   End
   Begin VB.Label lblINCOME 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "-"
      Height          =   255
      Left            =   5880
      TabIndex        =   90
      Top             =   3600
      Width           =   2145
   End
   Begin VB.Label lblPOP 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "-"
      Height          =   255
      Left            =   5880
      TabIndex        =   89
      Top             =   2760
      Width           =   2145
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RNDS As Integer
Sub GenerateTURF()
For i = 1 To 4
For ii = 0 To 11
For iii = 0 To 13
For iiii = 0 To 13
rn = Int((Rnd * 3) + 0.5)
Select Case i
Case 1
Select Case rn
Case 1: TURFWinter(ii).PSet (iii, iiii), &HFFFFFF
Case 2: TURFWinter(ii).PSet (iii, iiii), &HE0E0E0
Case 3: TURFWinter(ii).PSet (iii, iiii), &HFFFFC0
End Select
Case 2
Select Case rn
Case 1: TURFSpring(ii).PSet (iii, iiii), &H8080FF
Case 2: TURFSpring(ii).PSet (iii, iiii), &H8000&
Case 3: TURFSpring(ii).PSet (iii, iiii), &HC000&
End Select
Case 3
Select Case rn
Case 1: TURFSummer(ii).PSet (iii, iiii), &HC000&
Case 2: TURFSummer(ii).PSet (iii, iiii), &H8000&
Case 3: TURFSummer(ii).PSet (iii, iiii), &H4000&
End Select
Case 4
Select Case rn
Case 1: TURFFall(ii).PSet (iii, iiii), &H77B2&
Case 2: TURFFall(ii).PSet (iii, iiii), &H9DD5&
Case 3: TURFFall(ii).PSet (iii, iiii), &H5BBD&
End Select
End Select
Next
Next
Next
Next
End Sub

Private Sub BLTSELECTORS_Timer()
End Sub

Private Sub BirdTimer_Timer()
If Not CurrentSeason = 1 Then NewBird
rn2 = Rnd * 100
If rn2 > 49 Then FreakChangeInDirection
BirdTimer.Interval = RndRange(250, 2000)
End Sub

Private Sub Form_Load(): CURL = 1: CURC = 2
W = pbSCREEN.ScaleWidth
H = pbSCREEN.ScaleHeight

Math_BTT
initTILES
GenerateTURF
DrawBacks
Selector_Click 0
fileload

If CurrentSeason = 0 Then initTILES
DrawBoard

Form1.Caption = "CitySimulation - $" & Cash & "  " & ReturnMstr(CurMonth) & "  " & CurYear

DrawSelectors
Me.Show
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
filesave
End
End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub Frame2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub
Private Sub Frame3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub Frame4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub
Private Sub Frame5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub
Private Sub Label2_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub
Private Sub lblGrowth_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub lblINCOME_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub
Private Sub lblINCOME2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub
Private Sub lblLV_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub lblPOP_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub
Private Sub lblSPOP_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub lblZNum_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub lblZone_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub MainDrawTimer_Timer()
'skipBlt: DoEvents
'If Drawing Then GoTo skipBlt
BitBlt Buffer2.hDC, 0, 0, W, H, GFX.Turf(CurrentSeason).hDC, 0, 0, SRCCOPY

BitBlt Buffer2.hDC, 0, 0, W, H, BGPB2.hDC, 0, 0, SRCAND
BitBlt Buffer2.hDC, 0, 0, W, H, BGPB.hDC, 0, 0, SRCPAINT

If Not MouseOUT Then DoCURS Int(CX), Int(CY), Buffer2, CURC, CURL, CURS
DoBird

'Final Draw...
BitBlt pbSCREEN.hDC, 0, 0, W, H, Buffer2.hDC, 0, 0, SRCCOPY
Form1.Caption = "CitySimulation - $" & Cash & "  " & ReturnMstr(CurMonth) & " " & CurYear & "   Crime:" & Crime
End Sub

Private Sub pbSCREEN_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single): On Error Resume Next
CURL = 3
NX1 = Int(X / 13)
NY1 = Int(Y / 13)

If Button = 1 Then
If CURC = 1 Then Exit Sub

'Exit if purchase is not possible.
If Cash < MS.price Then Exit Sub

If Not T(NX1, NY1).StructureID > 9 And Not T(NX1, NY1).StructureID <= 20 Then

If MS.selectedPurchase > 20 And MS.selectedPurchase <= 32 Then
    If Not T(NX1, NY1).StructureID = 100 Then Exit Sub
    If Not T(NX1 + 1, NY1).StructureID = 100 Then Exit Sub
    If Not T(NX1, NY1 + 1).StructureID = 100 Then Exit Sub
    If Not T(NX1 + 1, NY1 + 1).StructureID = 100 Then Exit Sub
Else
    If Not T(NX1, NY1).StructureID = 100 Then Exit Sub
End If

End If

T(NX1, NY1).StructureID = MS.selectedPurchase

If T(NX1, NY1).StructureID <= 1 Then T(NX1, NY1).ColorFlag = Int(Rnd * 3): T(NX1, NY1).Name = RandResidence & " Residence"
If T(NX1, NY1).StructureID = 33 Then T(NX1, NY1).ColorFlag = Int(Rnd * 2)
If T(NX1, NY1).StructureID = 33 Or T(NX1, NY1).StructureID = 34 Then T(NX1, NY1).Name = "Trees"
If T(NX1, NY1).StructureID = 35 Then T(NX1, NY1).Name = "Bus Station"
If T(NX1, NY1).StructureID = 36 Then T(NX1, NY1).ClassFlag = Rnd * 2: T(NX1, NY1).Name = "Mini-Golf"
If T(NX1, NY1).StructureID > 1 And T(NX1, NY1).StructureID <= 5 Then If Not T(NX1, NY1).StructureID = 4 Then T(NX1, NY1).Name = RandSmallCom Else T(NX1, NY1).Name = "Public Pool"
If T(NX1, NY1).StructureID > 5 And T(NX1, NY1).StructureID <= 9 Then T(NX1, NY1).Name = RandSmallInd
If T(NX1, NY1).StructureID > 20 And T(NX1, NY1).StructureID <= 24 Then T(NX1, NY1).Name = RandBigRes
If T(NX1, NY1).StructureID > 24 And T(NX1, NY1).StructureID <= 27 Then T(NX1, NY1).Name = RandBigCom
If T(NX1, NY1).StructureID > 27 And T(NX1, NY1).StructureID <= 30 Then T(NX1, NY1).Name = RandBigInd
If T(NX1, NY1).StructureID = 31 Then T(NX1, NY1).Name = "The Fuzz"
If T(NX1, NY1).StructureID = 32 Then T(NX1, NY1).Name = "Fire Dept."

If T(NX1, NY1).StructureID > 20 And T(NX1, NY1).StructureID <= 32 Then
T(NX1 + 1, NY1).StructureID = 200
T(NX1 + 1, NY1 + 1).StructureID = 200
T(NX1, NY1 + 1).StructureID = 200
T(NX1 + 1, NY1).Name = T(NX1, NY1).Name
T(NX1 + 1, NY1 + 1).Name = T(NX1, NY1).Name
T(NX1, NY1 + 1).Name = T(NX1, NY1).Name
End If

If Not T(NX1, NY1).StructureID > 9 Then T(NX1, NY1).Growth = 1
If Not T(NX1, NY1).StructureID <= 20 Then T(NX1, NY1).Growth = 2
Cash = Cash - MS.price


End If

If Button = 2 Then
If T(NX1, NY1).StructureID = 100 Or T(NX1, NY1).StructureID = 200 Then Exit Sub
Cash = Cash + T(NX1, NY1).LandValue

If T(NX1, NY1).StructureID > 20 And T(NX1, NY1).StructureID <= 32 Then
T(NX1 + 1, NY1).StructureID = 100
T(NX1 + 1, NY1 + 1).StructureID = 100
T(NX1, NY1 + 1).StructureID = 100      'Kill 4 tile structure
T(NX1 + 1, NY1).Name = "Open Space"
T(NX1 + 1, NY1 + 1).Name = "Open Space"
T(NX1, NY1 + 1).Name = "Open Space"
End If

T(NX1, NY1).StructureID = 100
T(NX1, NY1).EarthTile = Rnd * 8
T(NX1, NY1).LandValue = 100
T(NX1, NY1).Population = 0               'Reset tile Vars
T(NX1, NY1).Growth = 0
T(NX1, NY1).ColorFlag = 0
T(NX1, NY1).Name = "Open Space"
End If

DrawBoard
End Sub

Private Sub pbSCREEN_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
MouseOUT = False
CX = X: CY = Y
NX = Int(X / 13)
NY = Int(Y / 13)

Select Case T(NX, NY).StructureID
Case Is < 2: lblZone = "Residential"
Case Is < 6: lblZone = "Commercial"
Case Is < 10: lblZone = "Industrial"
Case Is < 20: lblZone = "Major Road"
Case Is < 24: lblZone = "Residential"
Case Is < 27: lblZone = "Commercial"
Case Is < 30: lblZone = "Industrial"
Case Is < 33: lblZone = "Safety"
Case 100: lblZone = "Free"
Case 200: lblZone = "Structure"
Case Is > 32: lblZone = "FreeBe"
End Select
lblZNum = Trim(T(NX, NY).Name)
lblGrowth = T(NX, NY).Growth
lblSPOP = T(NX, NY).Population
lblLV = "$" & T(NX, NY).LandValue

If MS.selectedPurchase > 20 And MS.selectedPurchase <= 32 Then
CURS = 2
If Cash < MS.price Then CURC = 1: Exit Sub
If Not T(NX, NY).StructureID = 100 Then CURC = 1: Exit Sub
If Not T(NX + 1, NY).StructureID = 100 Then CURC = 1: Exit Sub
If Not T(NX, NY + 1).StructureID = 100 Then CURC = 1: Exit Sub
If Not T(NX + 1, NY + 1).StructureID = 100 Then CURC = 1: Exit Sub
CURC = 2
Else
CURS = 1
If Cash < MS.price Then CURC = 1: Exit Sub
If Not T(NX, NY).StructureID = 100 Then CURC = 1: Exit Sub
CURC = 2
End If

If Button = 1 Then pbSCREEN_MouseDown 1, Shift, X, Y
End Sub
Private Sub pbSCREEN_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
CURL = 2
DrawBoard
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub Selector_Click(Index As Integer)
For iiii = 0 To 36
Selector(iiii).BorderStyle = 0
Next
 
MS.selectedPurchase = Index
Selector(Index).BorderStyle = 1

If Index <= 9 Then MS.price = 90000
If Index > 9 And Index <= 20 Then MS.price = 2000
If Index > 20 And Index <= 32 Then MS.price = 300000
If Index > 32 Then MS.price = 0
End Sub

Private Sub Selector_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseOUT = True
End Sub

Private Sub TILEDATAUPDATE_Timer(): Dim TEMPIC As Long, PopC As Integer, RoadC As Integer
TotalPOP = 0: TEMPIC = 0: SafetyCount = 0: PopC = 0

For iii = 0 To MAPROWS 'Get Local Counts
For iiii = 0 To MAPCOLS
If T(iii, iiii).StructureID > 9 And T(iii, iiii).StructureID <= 20 Then RoadC = RoadC + 1
If T(iii, iiii).StructureID = 31 Or T(iii, iiii).StructureID = 32 Then SafetyCount = SafetyCount + 1
If T(iii, iiii).StructureID < 31 And T(iii, iiii).StructureID < 10 And T(iii, iiii).StructureID > 20 Then PopC = PopC + 1
Next
Next

Crime = (PopC / 4) - (2 * SafetyCount)

For iii = 0 To MAPROWS 'Update Tile Data/Stats
For iiii = 0 To MAPCOLS
If Not T(iii, iiii).StructureID = 100 Then
TotalPOP = TotalPOP + T(iii, iiii).Population

'Evade Filling Full House