source: branches/delphi/LocalPlayer/CityType.pas

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