source: branches/zoom/LocalPlayer/CityType.pas

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