-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathLoad.cls
206 lines (200 loc) · 6.13 KB
/
Load.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Load"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Declare Function BitBlt _
Lib "gdi32" ( _
ByVal hDestDC As Long, _
ByVal X As Long, ByVal ó 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 Sub Load_GMotion()
On Error GoTo FerstLoad
Open GameDir & "\Image\Personag\Npersonag\Personag_0_0.gif" For Binary As #1
Close #1
lReturn:
frmMon.Load
maxFurn = 45
Exit Sub
FerstLoad:
frmWork.ResetCaption "Èíèöèàëèçàöèÿ èãðû..."
frmWork.Show
DoEvents
FerstLoad.AddNFurniture
FerstLoad.AddNPersonag
Unload frmWork
GoTo lReturn
End Sub
Public Sub Load_Game(Company As String, Level As Integer, NumPersonag As Integer)
Dim imgX As ListImage
Dim Xstr As Integer
Dim Ystr As Integer
Dim sX As Single
Dim sY As Single
ServiseForm.Picture = Nothing
frmWork.ResetCaption " Çàãðóçêà èãðû"
frmWork.Show
DoEvents
'î÷èñòêà ðèñóíêîâ ìåáåëè/ïåðñîíàæåé
ClsPicture
'çàãðóçêà èãðû
LoadGameFiles Company, Level, NumPersonag
' îïðåäåëåíèå êîîðäèíàò ïåðñîíàæåé ïëèòêè
For Yp = 0 To 42
For Xp = 15 To 0 Step -1
Personag = Place(Xp, Yp, 3)
If Personag > 15 Then ' ïîèñê ïëèòêè
Map.FurnPaint Xp, Yp, (Personag - 16) * 2 + 1
End If
Next Xp
Next Yp
For Yp = 0 To 42
For Xp = 0 To 15
Personag = Place(Xp, Yp, 0)
If Personag > 31 And Personag < 255 Then ' ïîèñê ìåáåëè
Xstr = Place(Xp, Yp, 1)
Ystr = Place(Xp, Yp, 2)
Map.FurnPaint Xstr, Ystr, (Personag - 16) * 2 + 1
End If
If Personag < 16 Then ' ïîèñê ïåðñîíàæåé
Map.PlstoDec Xp, Yp, X(Personag), Y(Personag)
X(Personag) = X(Personag) - 23
Y(Personag) = Y(Personag) - 57
End If
Next Xp
Next Yp
ServiseForm.imlFon.ListImages.Clear
Set imgX = ServiseForm.imlFon.ListImages.Add(, , ServiseForm.Image)
Unload frmWork
End Sub
Public Sub LoadFurniture(NumerFurniture As Integer, Xp As Integer, Yp As Integer, Optional NumerBanc = 0)
' íîìåð èíòåðüåðà (0<=x<=239)
'çàãðóçêà èíòåðüåðà
PlaceMassiv NumerFurniture, Xp, Yp
' ïðîðèñîâêà èíòåðüåðà
Map.FurnPaint Xp, Yp, (NumerFurniture * 2) + 1
End Sub
Public Sub PlaceMassiv(NumerFurniture As Integer, Xp As Integer, Yp As Integer)
Dim Xstp As Integer
Dim Ystp As Integer
Dim X As Single
Dim Y As Single
Dim intWork As Integer
Dim Width As Integer, Height As Integer
Dim N As Integer
Xstp = Xp
Ystp = Yp
Width = FurnW(NumerFurniture)
Height = FurnH(NumerFurniture)
Map.PlstoDec Xstp, Ystp, X, Y
'ìåñòî óñòàíîâêè ñàìàÿ íèæíÿÿ êë. èíòåðüåðà
Place(Xp, Yp, 0) = NumerFurniture + 16 ' =èíòåðüåð
Place(Xp, Yp, 1) = Xp
Place(Xp, Yp, 2) = Yp
' up side
For N = 1 To Height - 1
Y = Y - 12
X = X + 24
Map.DectoPlc X, Y, Xstp, Ystp
Place(Xstp, Ystp, 0) = NumerFurniture + 16 ' =èíòåðüåð
Place(Xstp, Ystp, 1) = Xp
Place(Xstp, Ystp, 2) = Yp
Next N
'right side
For N = 1 To Width - 1
Y = Y - 12
X = X - 24
Map.DectoPlc X, Y, Xstp, Ystp
Place(Xstp, Ystp, 0) = NumerFurniture + 16 ' =èíòåðüåð
Place(Xstp, Ystp, 1) = Xp
Place(Xstp, Ystp, 2) = Yp
Next N
'doun side
For N = 1 To Height - 1
Y = Y + 12
X = X - 24
Map.DectoPlc X, Y, Xstp, Ystp
Place(Xstp, Ystp, 0) = NumerFurniture + 16 ' =èíòåðüåð
Place(Xstp, Ystp, 1) = Xp
Place(Xstp, Ystp, 2) = Yp
Next N
'left side
For N = 1 To Width - 1
Y = Y + 12
X = X + 24
Map.DectoPlc X, Y, Xstp, Ystp
Place(Xstp, Ystp, 0) = NumerFurniture + 16 ' =èíòåðüåð
Place(Xstp, Ystp, 1) = Xp
Place(Xstp, Ystp, 2) = Yp
Next N
End Sub
Public Sub ClsPicture()
Dim mintN As Integer
Dim ListCount As Integer
'î÷èñòêà ðèñóíêîâ ïåðñîíàæåé
ListCount = frmMon.imlMon.ListImages.Count
For mintN = ListCount To 1 Step -1
frmMon.imlMon.ListImages.Remove (mintN)
Next mintN
End Sub
Private Sub LoadGameFiles(Company As String, Level As Integer, NumPersonag As Integer)
Dim strPers As String
Dim strSpPers() As String
Dim strCompany As String
Dim strSpComp() As String
Dim Name As String
Dim mMaxFurn As Integer
Dim intN As Integer
Open GameDir & "\Companies\" & Company & ".comp" For Binary As #1
strCompany = Space(LOF(1))
Get #1, , strCompany
Close #1
strSpComp = Split(strCompany, " ")
Name = strSpComp(Level)
Open GameDir & "\Companies\Levels\" & Name & ".plc" For Binary As #1
Get #1, , Place()
Close #1
Open GameDir & "\Companies\Levels\" & Name & ".per" For Binary As #1
strPers = Space(LOF(1))
Get #1, , strPers
Close #1
strSpPers = Split(strPers, " ")
' çàãðóçêà ïåðñîíàæåé
NumPersonag = 0
For intN = 1 To UBound(strSpPers)
Mons.AddMons Int(Val(strSpPers(intN))), "Personag"
intPos(intN - 1) = 17
blnMove(intN - 1) = False
strDir(intN - 1) = "stand"
SeeDistance(intN - 1) = intN - 1
NumPersonag = NumPersonag + 1
Next intN
' çàãðóçêà ìåáåëè
mMaxFurn = maxFurn
For Yp = 0 To 42
For Xp = 15 To 0 Step -1
Personag = Place(Xp, Yp, 0)
If Personag > mMaxFurn And Personag <> 255 Then ' ïîèñê max ðèñóíêà ìåáåëè
maxFurn = Personag
End If
Next Xp
Next Yp
For intCount = maxFurn To mMaxFurn
Map.AddFurniture intCount, "Furniture"
Next intCount
'óñòàíîâêà íîâîãî ïîòîëêà
If mMaxFurn > maxFurn Then maxFurn = mMaxFurn
End Sub