source: trunk/LocalPlayer/CityType.pas

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