source: tags/1.2.0/LocalPlayer/CityType.pas

Last change on this file was 188, checked in by chronos, 4 years ago
  • Modified: Simplified code by replacing BitBlt which uses always handles by BitBltCanvas which uses directly TCanvas objects. Used default ROP SRCCOPY.
File size: 10.6 KB
Line 
1{$INCLUDE Switches.inc}
2unit CityType;
3
4interface
5
6uses
7 Protocol, ClientTools, Term, ScreenTools, BaseWin, LCLIntf, LCLType,
8 SysUtils, Classes, Graphics, Controls, Forms,
9 ButtonB, ExtCtrls;
10
11type
12 TCityTypeDlg = class(TFramedDlg)
13 CloseBtn: TButtonB;
14 DeleteBtn: TButtonB;
15 procedure CloseBtnClick(Sender: TObject);
16 procedure FormPaint(Sender: TObject);
17 procedure FormCreate(Sender: TObject);
18 procedure FormShow(Sender: TObject);
19 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
20 Shift: TShiftState; x, y: integer);
21 procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
22 Shift: TShiftState; x, y: integer);
23 procedure FormClose(Sender: TObject; var Action: TCloseAction);
24 procedure DeleteBtnClick(Sender: TObject);
25 public
26 procedure ShowNewContent(NewMode: integer);
27 protected
28 procedure OffscreenPaint; override;
29 private
30 nPool, dragiix, ctype: integer;
31 Pooliix: array [0 .. nImp - 1] of integer;
32 listed: Set of 0 .. nImp;
33 Changed: boolean;
34 procedure LoadType(NewType: integer);
35 procedure SaveType;
36 end;
37
38var
39 CityTypeDlg: TCityTypeDlg;
40
41implementation
42
43uses Help;
44
45{$R *.lfm}
46
47const
48 xList = 7;
49 yList = 0;
50 nListRow = 4;
51 nListCol = 10;
52 xPool = 7;
53 yPool = 220;
54 nPoolRow = 4;
55 nPoolCol = 10;
56 xSwitch = 7;
57 ySwitch = 150;
58 xView = 226;
59 yView = 130;
60
61procedure TCityTypeDlg.FormCreate(Sender: TObject);
62begin
63 inherited;
64 CaptionRight := CloseBtn.Left;
65 InitButtons();
66 HelpContext := 'MACRO';
67 Caption := Phrases.Lookup('TITLE_CITYTYPES');
68 DeleteBtn.Hint := Phrases.Lookup('BTN_DELETE');
69end;
70
71procedure TCityTypeDlg.CloseBtnClick(Sender: TObject);
72begin
73 Close
74end;
75
76procedure TCityTypeDlg.FormPaint(Sender: TObject);
77begin
78 inherited;
79 BtnFrame(Canvas, DeleteBtn.BoundsRect, MainTexture);
80end;
81
82procedure TCityTypeDlg.OffscreenPaint;
83var
84 i, iix: integer;
85 s: string;
86begin
87 inherited;
88 offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
89 FillOffscreen(xList - 7, yList, 42 * nListCol + 14, 32 * nListRow);
90 FillOffscreen(xPool - 7, yPool, 42 * nPoolCol + 14, 32 * nPoolRow);
91 FillOffscreen(0, yList + 32 * nListRow, 42 * nPoolCol + 14,
92 yPool - yList - 32 * nListRow);
93
94 Frame(offscreen.Canvas, 0, yList + 32 * nListRow, InnerWidth - 255,
95 yPool - 23, MainTexture.clBevelLight, MainTexture.clBevelShade);
96 Frame(offscreen.Canvas, InnerWidth - 254, yList + 32 * nListRow,
97 InnerWidth - 89, yPool - 23, MainTexture.clBevelLight,
98 MainTexture.clBevelShade);
99 Frame(offscreen.Canvas, InnerWidth - 88, yList + 32 * nListRow,
100 InnerWidth - 1, yPool - 23, MainTexture.clBevelLight,
101 MainTexture.clBevelShade);
102 Frame(offscreen.Canvas, 0, yPool - 22, InnerWidth - 1, yPool - 1,
103 MainTexture.clBevelLight, MainTexture.clBevelShade);
104 for i := 0 to nCityType - 1 do
105 begin
106 RFrame(offscreen.Canvas, xSwitch + i * 42, ySwitch, xSwitch + 39 + i * 42,
107 ySwitch + 23, MainTexture.clBevelShade, MainTexture.clBevelLight);
108 if i = ctype then
109 Frame(offscreen.Canvas, xSwitch + 1 + i * 42, ySwitch + 1,
110 xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.clBevelShade,
111 MainTexture.clBevelLight)
112 else
113 Frame(offscreen.Canvas, xSwitch + 1 + i * 42, ySwitch + 1,
114 xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.clBevelLight,
115 MainTexture.clBevelShade);
116 BitBltCanvas(offscreen.Canvas, xSwitch + 2 + i * 42, ySwitch + 2,
117 xSizeSmall, ySizeSmall, SmallImp.Canvas, (i + 3) * xSizeSmall, 0);
118 end;
119 RisedTextOut(offscreen.Canvas, 8, yList + 32 * nListRow + 2,
120 Phrases.Lookup('BUILDORDER'));
121 RisedTextOut(offscreen.Canvas, 8, ySwitch + 26,
122 Phrases.Lookup('CITYTYPE', ctype));
123 s := Phrases.Lookup('BUILDREST');
124 RisedTextOut(offscreen.Canvas,
125 (InnerWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2,
126 yList + 72 + 32 * nListRow, s);
127
128 with offscreen.Canvas do
129 begin
130 for i := 1 to nListRow - 1 do
131 DLine(offscreen.Canvas, xList - 5, xList + 4 + 42 * nListCol,
132 yList - 1 + 32 * i, MainTexture.clBevelLight, MainTexture.clBevelShade);
133 for i := 0 to nListCol * nListRow - 1 do
134 begin
135 s := IntToStr(i + 1);
136 Font.Color := MainTexture.clTextLight;
137 Textout(xList + 20 + i mod nListCol * 42 - TextWidth(s) div 2,
138 yList + 15 + i div nListCol * 32 - TextHeight(s) div 2, s);
139 end
140 end;
141
142 i := 0;
143 while MyData.ImpOrder[ctype, i] >= 0 do
144 begin
145 RFrame(offscreen.Canvas, xList + 20 - xSizeSmall div 2 + i mod nListCol *
146 42, yList + 15 - ySizeSmall div 2 + i div nListCol * 32,
147 xList + 21 + xSizeSmall div 2 + i mod nListCol * 42,
148 yList + 16 + ySizeSmall div 2 + i div nListCol * 32,
149 MainTexture.clBevelLight, MainTexture.clBevelShade);
150 BitBltCanvas(offscreen.Canvas, xList + 21 - xSizeSmall div 2 +
151 i mod nListCol * 42, yList + 16 - ySizeSmall div 2 + i div nListCol * 32,
152 xSizeSmall, ySizeSmall, SmallImp.Canvas,
153 MyData.ImpOrder[ctype, i] mod 7 * xSizeSmall,
154 (MyData.ImpOrder[ctype, i] + SystemIconLines * 7) div 7 *
155 ySizeSmall);
156 inc(i);
157 end;
158
159 nPool := 0;
160 for iix := 28 to nImp - 1 do
161 if not(iix in listed) and (Imp[iix].Kind = ikCommon) and (iix <> imTrGoods)
162 and (Imp[iix].Preq <> preNA) and
163 ((Imp[iix].Preq = preNone) or (MyRO.Tech[Imp[iix].Preq] >= tsApplicable))
164 then
165 begin
166 Pooliix[nPool] := iix;
167 RFrame(offscreen.Canvas, xPool + 20 - xSizeSmall div 2 +
168 nPool mod nPoolCol * 42, yPool + 15 - ySizeSmall div 2 +
169 nPool div nPoolCol * 32, xPool + 21 + xSizeSmall div 2 +
170 nPool mod nPoolCol * 42, yPool + 16 + ySizeSmall div 2 +
171 nPool div nPoolCol * 32, MainTexture.clBevelLight,
172 MainTexture.clBevelShade);
173 BitBltCanvas(offscreen.Canvas, xPool + 21 - xSizeSmall div 2 +
174 nPool mod nPoolCol * 42, yPool + 16 - ySizeSmall div 2 +
175 nPool div nPoolCol * 32, xSizeSmall, ySizeSmall, SmallImp.Canvas,
176 iix mod 7 * xSizeSmall, (iix + SystemIconLines * 7) div 7 *
177 ySizeSmall);
178 inc(nPool);
179 end;
180 DeleteBtn.Visible := MyData.ImpOrder[ctype, 0] >= 0;
181
182 if dragiix >= 0 then
183 begin
184 ImpImage(offscreen.Canvas, xView + 9, yView + 5, dragiix);
185 s := Phrases.Lookup('IMPROVEMENTS', dragiix);
186 RisedTextOut(offscreen.Canvas,
187 xView + 36 - BiColorTextWidth(offscreen.Canvas, s) div 2,
188 ySwitch + 26, s);
189 end;
190 MarkUsedOffscreen(InnerWidth, InnerHeight);
191end; { MainPaint }
192
193procedure TCityTypeDlg.LoadType(NewType: integer);
194var
195 i: integer;
196begin
197 ctype := NewType;
198 listed := [];
199 i := 0;
200 while MyData.ImpOrder[ctype, i] >= 0 do
201 begin
202 include(listed, MyData.ImpOrder[ctype, i]);
203 inc(i)
204 end;
205 Changed := false
206end;
207
208procedure TCityTypeDlg.SaveType;
209var
210 cix: integer;
211begin
212 if Changed then
213 begin
214 for cix := 0 to MyRO.nCity - 1 do
215 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Status and 7 = ctype + 1) then
216 AutoBuild(cix, MyData.ImpOrder[ctype]);
217 Changed := false
218 end;
219end;
220
221procedure TCityTypeDlg.FormShow(Sender: TObject);
222begin
223 LoadType(0);
224 dragiix := -1;
225 OffscreenPaint;
226end;
227
228procedure TCityTypeDlg.ShowNewContent(NewMode: integer);
229begin
230 inherited ShowNewContent(NewMode);
231end;
232
233procedure TCityTypeDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
234 Shift: TShiftState; x, y: integer);
235var
236 i: integer;
237begin
238 x := x - SideFrame;
239 y := y - WideFrame;
240 i := (x - xList) div 42 + (y - yList) div 32 * nListCol;
241 if (i < nImp) and (MyData.ImpOrder[ctype, i] >= 0) and
242 (x > xList + 2 + i mod nListCol * 42) and
243 (y > yList + 5 + i div nListCol * 32) and
244 (x < xList + 3 + 36 + i mod nListCol * 42) and
245 (y < yList + 6 + 20 + i div nListCol * 32) then
246 begin
247 if ssShift in Shift then
248 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp,
249 MyData.ImpOrder[ctype, i])
250 else
251 begin
252 dragiix := MyData.ImpOrder[ctype, i];
253 Screen.Cursor := crImpDrag;
254 SmartUpdateContent
255 end;
256 exit;
257 end;
258 i := (x - xPool) div 42 + (y - yPool) div 32 * nPoolCol;
259 if (i < nPool) and (x > xPool + 2 + i mod nPoolCol * 42) and
260 (y > yPool + 5 + i div nPoolCol * 32) and
261 (x < xPool + 3 + 36 + i mod nPoolCol * 42) and
262 (y < yPool + 6 + 20 + i div nPoolCol * 32) then
263 begin
264 if ssShift in Shift then
265 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Pooliix[i])
266 else
267 begin
268 dragiix := Pooliix[i];
269 Screen.Cursor := crImpDrag;
270 SmartUpdateContent
271 end;
272 exit;
273 end;
274 i := (x - xSwitch) div 42;
275 if (i < nCityType) and (x > xSwitch + 2 + i * 42) and
276 (x < xSwitch + 3 + 36 + i * 42) and (y >= ySwitch + 2) and (y < ySwitch + 22)
277 then
278 begin
279 SaveType;
280 LoadType(i);
281 SmartUpdateContent
282 end
283end;
284
285procedure TCityTypeDlg.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
286 Shift: TShiftState; x, y: integer);
287
288 procedure UnList(iix: integer);
289 var
290 i: integer;
291 begin
292 i := 0;
293 while (MyData.ImpOrder[ctype, i] >= 0) and
294 (MyData.ImpOrder[ctype, i] <> iix) do
295 inc(i);
296 assert(MyData.ImpOrder[ctype, i] = iix);
297 move(MyData.ImpOrder[ctype, i + 1], MyData.ImpOrder[ctype, i], nImp - i);
298 Exclude(listed, iix);
299 end;
300
301var
302 i: integer;
303begin
304 x := x - SideFrame;
305 y := y - WideFrame;
306 if dragiix >= 0 then
307 begin
308 if (x >= xList) and (x < xList + nListCol * 42) and (y >= yList) and
309 (y < yList + nListRow * 32) then
310 begin
311 if dragiix in listed then
312 UnList(dragiix);
313 i := (x - xList) div 42 + (y - yList) div 32 * nListCol;
314 while (i > 0) and (MyData.ImpOrder[ctype, i - 1] < 0) do
315 dec(i);
316 move(MyData.ImpOrder[ctype, i], MyData.ImpOrder[ctype, i + 1],
317 nImp - i - 1);
318 MyData.ImpOrder[ctype, i] := dragiix;
319 include(listed, dragiix);
320 Changed := true
321 end
322 else if (dragiix in listed) and (x >= xPool) and (x < xPool + nPoolCol * 42)
323 and (y >= yPool) and (y < yPool + nPoolRow * 32) then
324 begin
325 UnList(dragiix);
326 Changed := true
327 end;
328 dragiix := -1;
329 SmartUpdateContent
330 end;
331 Screen.Cursor := crDefault
332end;
333
334procedure TCityTypeDlg.FormClose(Sender: TObject; var Action: TCloseAction);
335begin
336 SaveType;
337 inherited;
338end;
339
340procedure TCityTypeDlg.DeleteBtnClick(Sender: TObject);
341begin
342 fillchar(MyData.ImpOrder[ctype], sizeof(MyData.ImpOrder[ctype]), Byte(-1));
343 listed := [];
344 Changed := true;
345 SmartUpdateContent;
346end;
347
348end.
Note: See TracBrowser for help on using the repository browser.