1 | {$INCLUDE Switches.inc}
|
---|
2 | unit Draft;
|
---|
3 |
|
---|
4 | interface
|
---|
5 |
|
---|
6 | uses
|
---|
7 | Protocol, ClientTools, Term, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils,
|
---|
8 | Classes, Graphics, Controls, Forms, ExtCtrls, ButtonA, ButtonB, Area;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TDraftDlg = class(TBufferedDrawDlg)
|
---|
12 | OKBtn: TButtonA;
|
---|
13 | CloseBtn: TButtonB;
|
---|
14 | GroundArea: TArea;
|
---|
15 | SeaArea: TArea;
|
---|
16 | AirArea: TArea;
|
---|
17 | procedure FormCreate(Sender: TObject);
|
---|
18 | procedure FormDestroy(Sender: TObject);
|
---|
19 | procedure FormShow(Sender: TObject);
|
---|
20 | procedure CloseBtnClick(Sender: TObject);
|
---|
21 | procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
|
---|
22 | Shift: TShiftState; x, y: integer);
|
---|
23 | procedure OKBtnClick(Sender: TObject);
|
---|
24 | procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
|
---|
25 | Shift: TShiftState; x, y: integer);
|
---|
26 | public
|
---|
27 | procedure ShowNewContent(NewMode: TWindowMode);
|
---|
28 | protected
|
---|
29 | procedure OffscreenPaint; override;
|
---|
30 | private
|
---|
31 | Domain, MaxLines, Lines, Cut, yDomain, yFeature, yWeight, yTotal, yView,
|
---|
32 | IncCap, DecCap: integer;
|
---|
33 | code: array [0 .. nFeature - 1] of integer;
|
---|
34 | Template, Back: TBitmap;
|
---|
35 | function IsFeatureInList(d, i: integer): boolean;
|
---|
36 | procedure SetDomain(d: integer);
|
---|
37 | end;
|
---|
38 |
|
---|
39 | var
|
---|
40 | DraftDlg: TDraftDlg;
|
---|
41 |
|
---|
42 |
|
---|
43 | implementation
|
---|
44 |
|
---|
45 | uses
|
---|
46 | Help, Tribes, Directories;
|
---|
47 |
|
---|
48 | {$R *.lfm}
|
---|
49 |
|
---|
50 | const
|
---|
51 | MaxLines0 = 11;
|
---|
52 | LinePitch = 20;
|
---|
53 | xDomain = 30;
|
---|
54 | yDomain0 = 464;
|
---|
55 | DomainPitch = 40;
|
---|
56 | xFeature = 38;
|
---|
57 | yFeature0 = 42;
|
---|
58 | xWeight = 100;
|
---|
59 | yWeight0 = 271;
|
---|
60 | xTotal = 20;
|
---|
61 | xTotal2 = 34;
|
---|
62 | yTotal0 = 354;
|
---|
63 | xView = 17;
|
---|
64 | yView0 = 283;
|
---|
65 |
|
---|
66 | procedure TDraftDlg.FormCreate(Sender: TObject);
|
---|
67 | begin
|
---|
68 | inherited;
|
---|
69 | InitButtons;
|
---|
70 | HelpContext := 'CLASSES';
|
---|
71 | Caption := Phrases.Lookup('TITLE_DRAFT');
|
---|
72 | OKBtn.Caption := Phrases.Lookup('BTN_OK');
|
---|
73 |
|
---|
74 | if not Phrases2FallenBackToEnglish then
|
---|
75 | begin
|
---|
76 | GroundArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 0);
|
---|
77 | SeaArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 1);
|
---|
78 | AirArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 2);
|
---|
79 | end
|
---|
80 | else
|
---|
81 | begin
|
---|
82 | GroundArea.Hint := Phrases.Lookup('DOMAIN', 0);
|
---|
83 | SeaArea.Hint := Phrases.Lookup('DOMAIN', 1);
|
---|
84 | AirArea.Hint := Phrases.Lookup('DOMAIN', 2);
|
---|
85 | end;
|
---|
86 |
|
---|
87 | Back := TBitmap.Create;
|
---|
88 | Back.PixelFormat := pf24bit;
|
---|
89 | Back.SetSize(Width, Height);
|
---|
90 | Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);
|
---|
91 | Template := TBitmap.Create;
|
---|
92 | Template.PixelFormat := pf24bit;
|
---|
93 | LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'MiliRes.png',
|
---|
94 | [gfNoGamma]);
|
---|
95 | end;
|
---|
96 |
|
---|
97 | procedure TDraftDlg.FormDestroy(Sender: TObject);
|
---|
98 | begin
|
---|
99 | FreeAndNil(Template);
|
---|
100 | FreeAndNil(Back);
|
---|
101 | end;
|
---|
102 |
|
---|
103 | procedure TDraftDlg.CloseBtnClick(Sender: TObject);
|
---|
104 | begin
|
---|
105 | ModalResult := mrCancel;
|
---|
106 | end;
|
---|
107 |
|
---|
108 | procedure TDraftDlg.OffscreenPaint;
|
---|
109 |
|
---|
110 | function DomainAvailable(d: integer): boolean;
|
---|
111 | begin
|
---|
112 | result := (upgrade[d, 0].Preq = preNone) or
|
---|
113 | (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable);
|
---|
114 | end;
|
---|
115 |
|
---|
116 | procedure PaintTotalBars;
|
---|
117 | var
|
---|
118 | i, y, dx, num, w: integer;
|
---|
119 | s: string;
|
---|
120 | begin
|
---|
121 | with offscreen.Canvas do
|
---|
122 | begin
|
---|
123 | // strength bar
|
---|
124 | y := yTotal;
|
---|
125 | DarkGradient(offscreen.Canvas, xTotal - 6, y + 1, 184, 2);
|
---|
126 | DarkGradient(offscreen.Canvas, xTotal2 + 172, y + 1, 95, 2);
|
---|
127 | RisedTextOut(offscreen.Canvas, xTotal - 2, y,
|
---|
128 | Phrases.Lookup('UNITSTRENGTH'));
|
---|
129 | RisedTextOut(offscreen.Canvas, xTotal + 112 + 30, y,
|
---|
130 | 'x' + IntToStr(MyRO.DevModel.MStrength));
|
---|
131 | RisedTextOut(offscreen.Canvas, xTotal2 + 148 + 30, y, '=');
|
---|
132 | s := IntToStr(MyRO.DevModel.Attack) + '/' +
|
---|
133 | IntToStr(MyRO.DevModel.Defense);
|
---|
134 | RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 -
|
---|
135 | BiColorTextWidth(offscreen.Canvas, s), y, s);
|
---|
136 |
|
---|
137 | // transport bar
|
---|
138 | if MyRO.DevModel.MTrans > 0 then
|
---|
139 | begin
|
---|
140 | y := yTotal + 19;
|
---|
141 | DarkGradient(offscreen.Canvas, xTotal - 6, y + 1, 184, 1);
|
---|
142 | DarkGradient(offscreen.Canvas, xTotal2 + 172, y + 1, 95, 1);
|
---|
143 | RisedTextOut(offscreen.Canvas, xTotal - 2, y,
|
---|
144 | Phrases.Lookup('UNITTRANSPORT'));
|
---|
145 | RisedTextOut(offscreen.Canvas, xTotal + 112 + 30, y,
|
---|
146 | 'x' + IntToStr(MyRO.DevModel.MTrans));
|
---|
147 | RisedTextOut(offscreen.Canvas, xTotal2 + 148 + 30, y, '=');
|
---|
148 |
|
---|
149 | Font.Color := $000000;
|
---|
150 | dx := -237 - 30;
|
---|
151 | for i := mcFirstNonCap - 1 downto 3 do
|
---|
152 | if i in [mcSeaTrans, mcCarrier, mcAirTrans] then
|
---|
153 | begin
|
---|
154 | num := MyRO.DevModel.Cap[i] * MyRO.DevModel.MTrans;
|
---|
155 | if num > 0 then
|
---|
156 | begin
|
---|
157 | inc(dx, 15);
|
---|
158 | Brush.Color := $C0C0C0;
|
---|
159 | FrameRect(Rect(xTotal2 - 3 - dx, y + 2,
|
---|
160 | xTotal2 + 11 - dx, y + 16));
|
---|
161 | Brush.Style := bsClear;
|
---|
162 | Sprite(offscreen, HGrSystem, xTotal2 - 1 - dx, y + 4, 10, 10,
|
---|
163 | 66 + i mod 11 * 11, 137 + i div 11 * 11);
|
---|
164 | if num > 1 then
|
---|
165 | begin
|
---|
166 | s := IntToStr(num);
|
---|
167 | w := TextWidth(s);
|
---|
168 | inc(dx, w + 1);
|
---|
169 | Brush.Color := $FFFFFF;
|
---|
170 | FillRect(Rect(xTotal2 - 3 - dx, y + 2,
|
---|
171 | xTotal2 + w - 1 - dx, y + 16));
|
---|
172 | Brush.Style := bsClear;
|
---|
173 | Textout(xTotal2 - 3 - dx + 1, y, s);
|
---|
174 | end;
|
---|
175 | end;
|
---|
176 | end;
|
---|
177 | end;
|
---|
178 |
|
---|
179 | // speed bar
|
---|
180 | y := yTotal + 38;
|
---|
181 | LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y,
|
---|
182 | Phrases.Lookup('UNITSPEED'));
|
---|
183 | DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16,
|
---|
184 | MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
|
---|
185 | DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16,
|
---|
186 | MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
|
---|
187 | s := MovementToString(MyRO.DevModel.Speed);
|
---|
188 | RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 -
|
---|
189 | TextWidth(s), y, s);
|
---|
190 |
|
---|
191 | // cost bar
|
---|
192 | y := yTotal + 57;
|
---|
193 | LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y,
|
---|
194 | Phrases.Lookup('UNITCOST'));
|
---|
195 | LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal + 112 + 30, y,
|
---|
196 | 'x' + IntToStr(MyRO.DevModel.MCost));
|
---|
197 | LoweredTextOut(offscreen.Canvas, -1, MainTexture,
|
---|
198 | xTotal2 + 148 + 30, y, '=');
|
---|
199 | DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16,
|
---|
200 | MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
|
---|
201 | DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16,
|
---|
202 | MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
|
---|
203 | s := IntToStr(MyRO.DevModel.Cost);
|
---|
204 | RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 -
|
---|
205 | TextWidth(s), y, s);
|
---|
206 | Sprite(offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y + 4, 10,
|
---|
207 | 10, 88, 115);
|
---|
208 |
|
---|
209 | if G.Difficulty[me] <> 2 then
|
---|
210 | begin // corrected cost bar
|
---|
211 | y := yTotal + 76;
|
---|
212 | LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y,
|
---|
213 | Phrases.Lookup('COSTDIFF' + char(48 + G.Difficulty[me])));
|
---|
214 | LoweredTextOut(offscreen.Canvas, -1, MainTexture,
|
---|
215 | xTotal2 + 148 + 30, y, '=');
|
---|
216 | DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16,
|
---|
217 | MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
|
---|
218 | DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16,
|
---|
219 | MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
|
---|
220 | s := IntToStr(MyRO.DevModel.Cost * BuildCostMod
|
---|
221 | [G.Difficulty[me]] div 12);
|
---|
222 | RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 -
|
---|
223 | TextWidth(s), y, s);
|
---|
224 | Sprite(offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y + 4, 10,
|
---|
225 | 10, 88, 115);
|
---|
226 | end;
|
---|
227 | end;
|
---|
228 | end;
|
---|
229 |
|
---|
230 | var
|
---|
231 | i, j, x, d, n, TextColor, CapWeight, DomainCount: integer;
|
---|
232 | begin
|
---|
233 | inherited;
|
---|
234 | UnshareBitmap(Back);
|
---|
235 |
|
---|
236 | ClientHeight := Template.Height - Cut;
|
---|
237 | if ClientHeight > MainTexture.Height then
|
---|
238 | // assemble background from 2 texture tiles
|
---|
239 | begin
|
---|
240 | BitBltCanvas(Back.Canvas, 0, 0, ClientWidth, 64,
|
---|
241 | MainTexture.Image.Canvas, (MainTexture.Width - ClientWidth) div 2,
|
---|
242 | MainTexture.Height - 64);
|
---|
243 | BitBltCanvas(Back.Canvas, 0, 64, ClientWidth, ClientHeight - 64,
|
---|
244 | MainTexture.Image.Canvas, (MainTexture.Width - ClientWidth) div 2,
|
---|
245 | 0);
|
---|
246 | end
|
---|
247 | else
|
---|
248 | BitBltCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight,
|
---|
249 | MainTexture.Image.Canvas, (MainTexture.Width - ClientWidth) div 2,
|
---|
250 | (MainTexture.Height - ClientHeight) div 2);
|
---|
251 | ImageOp_B(Back, Template, 0, 0, 0, 0, Template.Width, 64);
|
---|
252 | ImageOp_B(Back, Template, 0, 64, 0, 64 + Cut, Template.Width,
|
---|
253 | Template.Height - 64 - Cut);
|
---|
254 |
|
---|
255 | BitBltCanvas(offscreen.Canvas, 0, 0, ClientWidth, ClientHeight,
|
---|
256 | Back.Canvas, 0, 0);
|
---|
257 |
|
---|
258 | offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
|
---|
259 | RisedTextOut(offscreen.Canvas, 10, 7, Caption);
|
---|
260 | offscreen.Canvas.Font.Assign(UniFont[ftSmall]);
|
---|
261 |
|
---|
262 | with MyRO.DevModel do
|
---|
263 | begin
|
---|
264 | DomainCount := 0;
|
---|
265 | for d := 0 to nDomains - 1 do
|
---|
266 | if DomainAvailable(d) then
|
---|
267 | inc(DomainCount);
|
---|
268 | if DomainCount > 1 then
|
---|
269 | begin
|
---|
270 | for d := 0 to nDomains - 1 do
|
---|
271 | if DomainAvailable(d) then
|
---|
272 | begin
|
---|
273 | x := xDomain + d * DomainPitch;
|
---|
274 | if d = Domain then
|
---|
275 | ImageOp_BCC(offscreen, Templates.Data, x, yDomain, 142, 246 + 37 * d, 36,
|
---|
276 | 36, 0, $00C0FF)
|
---|
277 | else
|
---|
278 | ImageOp_BCC(offscreen, Templates.Data, x, yDomain, 142, 246 + 37 * d, 36,
|
---|
279 | 36, 0, $606060);
|
---|
280 | end;
|
---|
281 | Frame(offscreen.Canvas, xDomain - 11, yDomain - 3,
|
---|
282 | xDomain + 2 * DomainPitch + 46, yDomain + 38, $B0B0B0, $FFFFFF);
|
---|
283 | RFrame(offscreen.Canvas, xDomain - 12, yDomain - 4,
|
---|
284 | xDomain + 2 * DomainPitch + 47, yDomain + 39, $FFFFFF, $B0B0B0);
|
---|
285 | end;
|
---|
286 | GroundArea.Top := yDomain;
|
---|
287 | GroundArea.Visible := DomainAvailable(dGround);
|
---|
288 | SeaArea.Top := yDomain;
|
---|
289 | SeaArea.Visible := DomainAvailable(dSea);
|
---|
290 | AirArea.Top := yDomain;
|
---|
291 | AirArea.Visible := DomainAvailable(dAir);
|
---|
292 |
|
---|
293 | PaintTotalBars;
|
---|
294 |
|
---|
295 | // display weight
|
---|
296 | with offscreen.Canvas do
|
---|
297 | begin
|
---|
298 | for i := 0 to MaxWeight - 1 do
|
---|
299 | if i < Weight then
|
---|
300 | ImageOp_BCC(offscreen, Templates.Data, Point(xWeight + 20 * i, yWeight),
|
---|
301 | WeightOn.BoundsRect, 0, $949494)
|
---|
302 | else
|
---|
303 | ImageOp_BCC(offscreen, Templates.Data, Point(xWeight + 20 * i, yWeight),
|
---|
304 | WeightOff.BoundsRect, 0, $949494);
|
---|
305 | end;
|
---|
306 |
|
---|
307 | with offscreen.Canvas do
|
---|
308 | for i := 0 to Lines - 1 do
|
---|
309 | begin
|
---|
310 | if not(code[i] in AutoFeature) then
|
---|
311 | begin
|
---|
312 | // paint +/- butttons
|
---|
313 | if code[i] < mcFirstNonCap then
|
---|
314 | begin
|
---|
315 | Dump(offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch *
|
---|
316 | i, 12, 12, 169, 172);
|
---|
317 | Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch *
|
---|
318 | i, 12, 12, 169, 159);
|
---|
319 | RFrame(offscreen.Canvas, xFeature - (21 + 1),
|
---|
320 | yFeature + 2 + LinePitch * i - 1, xFeature - (21 - 24),
|
---|
321 | yFeature + 2 + LinePitch * i + 12, MainTexture.ColorBevelShade,
|
---|
322 | MainTexture.ColorBevelLight);
|
---|
323 | end
|
---|
324 | else
|
---|
325 | begin
|
---|
326 | Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch *
|
---|
327 | i, 12, 12, 169, 185 + 13 * MyRO.DevModel.Cap[code[i]]);
|
---|
328 | RFrame(offscreen.Canvas, xFeature - (9 + 1),
|
---|
329 | yFeature + 2 + LinePitch * i - 1, xFeature - (21 - 24),
|
---|
330 | yFeature + 2 + LinePitch * i + 12, MainTexture.ColorBevelShade,
|
---|
331 | MainTexture.ColorBevelLight);
|
---|
332 | end;
|
---|
333 |
|
---|
334 | // paint cost
|
---|
335 | LightGradient(offscreen.Canvas, xFeature + 34,
|
---|
336 | yFeature + LinePitch * i, 50, HGrSystem.Data.Canvas.Pixels
|
---|
337 | [187, 137]);
|
---|
338 | if (Domain = dGround) and (code[i] = mcDefense) then
|
---|
339 | CapWeight := 2
|
---|
340 | else
|
---|
341 | CapWeight := Feature[code[i]].Weight;
|
---|
342 | n := CapWeight + Feature[code[i]].Cost;
|
---|
343 | d := 6;
|
---|
344 | while (n - 1) * d * 2 > 48 - 10 do
|
---|
345 | dec(d);
|
---|
346 | for j := 0 to n - 1 do
|
---|
347 | if j < CapWeight then
|
---|
348 | Sprite(offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d,
|
---|
349 | yFeature + 2 + LinePitch * i + 1, 10, 10, 88, 126)
|
---|
350 | else
|
---|
351 | Sprite(offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d,
|
---|
352 | yFeature + 2 + LinePitch * i + 1, 10, 10, 88, 115);
|
---|
353 | end; // if not (code[i] in AutoFeature)
|
---|
354 | DarkGradient(offscreen.Canvas, xFeature + 17,
|
---|
355 | yFeature + LinePitch * i, 16, 1);
|
---|
356 | ScreenTools.Frame(offscreen.Canvas, xFeature + 18, yFeature + 1 + LinePitch * i,
|
---|
357 | xFeature + 20 - 2 + 13, yFeature + 2 + 1 - 2 + 13 + LinePitch * i,
|
---|
358 | $C0C0C0, $C0C0C0);
|
---|
359 | Sprite(offscreen, HGrSystem, xFeature + 20, yFeature + 2 + 1 + LinePitch
|
---|
360 | * i, 10, 10, 66 + code[i] mod 11 * 11, 137 + code[i] div 11 * 11);
|
---|
361 |
|
---|
362 | if MyRO.DevModel.Cap[code[i]] > 0 then
|
---|
363 | TextColor := MainTexture.ColorLitText
|
---|
364 | else
|
---|
365 | TextColor := -1;
|
---|
366 |
|
---|
367 | if code[i] < mcFirstNonCap then
|
---|
368 | LoweredTextOut(offscreen.Canvas, TextColor, MainTexture, xFeature + 7,
|
---|
369 | yFeature + LinePitch * i - 1, IntToStr(MyRO.DevModel.Cap[code[i]]));
|
---|
370 | LoweredTextOut(offscreen.Canvas, TextColor, MainTexture, xFeature + 88,
|
---|
371 | yFeature + LinePitch * i - 1, Phrases.Lookup('FEATURES', code[i]));
|
---|
372 | end;
|
---|
373 | end;
|
---|
374 |
|
---|
375 | // free features
|
---|
376 | j := 0;
|
---|
377 | for i := 0 to nFeature - 1 do
|
---|
378 | if (i in AutoFeature) and (1 shl Domain and Feature[i].Domains <> 0) and
|
---|
379 | (Feature[i].Preq <> preNA) and
|
---|
380 | ((Feature[i].Preq = preSun) and (MyRO.Wonder[woSun].EffectiveOwner = me)
|
---|
381 | or (Feature[i].Preq >= 0) and (MyRO.Tech[Feature[i].Preq] >= tsApplicable)
|
---|
382 | ) and not((Feature[i].Preq = adSteamEngine) and
|
---|
383 | (MyRO.Tech[adNuclearPower] >= tsApplicable)) then
|
---|
384 | begin
|
---|
385 | DarkGradient(offscreen.Canvas, xWeight + 4, yWeight + 32 + LinePitch
|
---|
386 | * j, 16, 1);
|
---|
387 | Frame(offscreen.Canvas, xWeight + 5, yWeight + 33 + LinePitch * j,
|
---|
388 | xWeight + 18, yWeight + 47 + LinePitch * j, $C0C0C0, $C0C0C0);
|
---|
389 | Sprite(offscreen, HGrSystem, xWeight + 7, yWeight + 36 + LinePitch * j,
|
---|
390 | 10, 10, 66 + i mod 11 * 11, 137 + i div 11 * 11);
|
---|
391 | LoweredTextOut(offscreen.Canvas, -1, MainTexture, xWeight + 26,
|
---|
392 | yWeight + 31 + LinePitch * j, Phrases.Lookup('FEATURES', i));
|
---|
393 | inc(j);
|
---|
394 | end;
|
---|
395 |
|
---|
396 | with Tribe[me].ModelPicture[MyRO.nModel] do
|
---|
397 | begin
|
---|
398 | FrameImage(offscreen.Canvas, BigImp, xView + 4, yView + 4, xSizeBig,
|
---|
399 | ySizeBig, 0, 0);
|
---|
400 | Sprite(offscreen, HGr, xView, yView, 64, 44, pix mod 10 * 65 + 1,
|
---|
401 | pix div 10 * 49 + 1);
|
---|
402 | end;
|
---|
403 | MarkUsedOffscreen(ClientWidth, ClientHeight);
|
---|
404 | end;
|
---|
405 |
|
---|
406 | procedure TDraftDlg.SetDomain(d: integer);
|
---|
407 |
|
---|
408 | function Prio(fix: integer): integer;
|
---|
409 | var
|
---|
410 | FeaturePreq: integer;
|
---|
411 | begin
|
---|
412 | FeaturePreq := Feature[fix].Preq;
|
---|
413 | assert(FeaturePreq <> preNA);
|
---|
414 | if fix < mcFirstNonCap then
|
---|
415 | result := 10000 + fix
|
---|
416 | else if FeaturePreq = preNone then
|
---|
417 | result := 20000
|
---|
418 | else if FeaturePreq < 0 then
|
---|
419 | result := 40000
|
---|
420 | else
|
---|
421 | result := 30000 + AdvValue[FeaturePreq];
|
---|
422 | if not(fix in AutoFeature) then
|
---|
423 | inc(result, 90000);
|
---|
424 | end;
|
---|
425 |
|
---|
426 | var
|
---|
427 | i, j, x: integer;
|
---|
428 | begin
|
---|
429 | Domain := d;
|
---|
430 | Lines := 0;
|
---|
431 | for i := 0 to nFeature - 1 do
|
---|
432 | if IsFeatureInList(Domain, i) then
|
---|
433 | begin
|
---|
434 | code[Lines] := i;
|
---|
435 | inc(Lines);
|
---|
436 | end;
|
---|
437 | yFeature := yFeature0 + (MaxLines - Lines) * LinePitch div 2;
|
---|
438 |
|
---|
439 | // sort features
|
---|
440 | for i := 0 to Lines - 2 do
|
---|
441 | for j := i + 1 to Lines - 1 do
|
---|
442 | if Prio(code[i]) > Prio(code[j]) then
|
---|
443 | begin // exchange
|
---|
444 | x := code[i];
|
---|
445 | code[i] := code[j];
|
---|
446 | code[j] := x;
|
---|
447 | end;
|
---|
448 | end;
|
---|
449 |
|
---|
450 | function TDraftDlg.IsFeatureInList(d, i: integer): boolean;
|
---|
451 | begin
|
---|
452 | result := not(i in AutoFeature) and (1 shl d and Feature[i].Domains <> 0) and
|
---|
453 | (Feature[i].Preq <> preNA) and
|
---|
454 | ((Feature[i].Preq = preNone) or (Feature[i].Preq = preSun) and
|
---|
455 | (MyRO.Wonder[woSun].EffectiveOwner = me) or (Feature[i].Preq >= 0) and
|
---|
456 | (MyRO.Tech[Feature[i].Preq] >= tsApplicable));
|
---|
457 | end;
|
---|
458 |
|
---|
459 | procedure TDraftDlg.FormShow(Sender: TObject);
|
---|
460 | var
|
---|
461 | count, d, i: integer;
|
---|
462 | begin
|
---|
463 | Domain := dGround;
|
---|
464 | while (Domain < dAir) and (upgrade[Domain, 0].Preq <> preNone) and
|
---|
465 | (MyRO.Tech[upgrade[Domain, 0].Preq] < tsApplicable) do
|
---|
466 | inc(Domain);
|
---|
467 |
|
---|
468 | // count max number of features in any domain
|
---|
469 | MaxLines := 0;
|
---|
470 | for d := 0 to nDomains - 1 do
|
---|
471 | if (upgrade[d, 0].Preq = preNone) or
|
---|
472 | (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable) then
|
---|
473 | begin
|
---|
474 | count := 0;
|
---|
475 | for i := 0 to nFeature - 1 do
|
---|
476 | if IsFeatureInList(d, i) then
|
---|
477 | inc(count);
|
---|
478 | if count > MaxLines then
|
---|
479 | MaxLines := count;
|
---|
480 | end;
|
---|
481 | Cut := (MaxLines0 - MaxLines) * LinePitch;
|
---|
482 | OKBtn.Top := 477 - Cut;
|
---|
483 | yDomain := yDomain0 - Cut;
|
---|
484 | yWeight := yWeight0 - Cut;
|
---|
485 | yTotal := yTotal0 - Cut;
|
---|
486 | yView := yView0 - Cut;
|
---|
487 |
|
---|
488 | if WindowMode = wmModal then
|
---|
489 | begin { center on screen }
|
---|
490 | Left := (Screen.Width - Template.Width) div 2;
|
---|
491 | Top := (Screen.Height - (Template.Height - Cut)) div 2;
|
---|
492 | end;
|
---|
493 |
|
---|
494 | SetDomain(Domain);
|
---|
495 | Server(sCreateDevModel, me, Domain, nil^);
|
---|
496 | MyModel[MyRO.nModel] := MyRO.DevModel;
|
---|
497 | InitMyModel(MyRO.nModel, false);
|
---|
498 | OffscreenPaint;
|
---|
499 | IncCap := -1;
|
---|
500 | DecCap := -1;
|
---|
501 | end;
|
---|
502 |
|
---|
503 | procedure TDraftDlg.ShowNewContent(NewMode: TWindowMode);
|
---|
504 | begin
|
---|
505 | inherited ShowNewContent(NewMode);
|
---|
506 | end;
|
---|
507 |
|
---|
508 | procedure TDraftDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
|
---|
509 | Shift: TShiftState; x, y: integer);
|
---|
510 | var
|
---|
511 | i, d: integer;
|
---|
512 | begin
|
---|
513 | if Button = mbLeft then
|
---|
514 | begin
|
---|
515 | for d := 0 to nDomains - 1 do
|
---|
516 | if (d <> Domain) and ((upgrade[d, 0].Preq = preNone) or
|
---|
517 | (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable)) and
|
---|
518 | (x >= xDomain + d * DomainPitch) and
|
---|
519 | (x < xDomain + d * DomainPitch + 36) and (y >= yDomain) and
|
---|
520 | (y < yDomain + 36) then
|
---|
521 | begin
|
---|
522 | SetDomain(d);
|
---|
523 | Server(sCreateDevModel, me, Domain, nil^);
|
---|
524 | MyModel[MyRO.nModel] := MyRO.DevModel;
|
---|
525 | InitMyModel(MyRO.nModel, false);
|
---|
526 | SmartUpdateContent;
|
---|
527 | end;
|
---|
528 |
|
---|
529 | if (y >= yFeature) and (y < yFeature + LinePitch * Lines) then
|
---|
530 | begin
|
---|
531 | i := (y - yFeature) div LinePitch;
|
---|
532 | if (x >= xFeature - 21) and (x < ClientWidth) and (ssShift in Shift) then
|
---|
533 | HelpDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), hkFeature, code[i])
|
---|
534 | else if not(code[i] in AutoFeature) then
|
---|
535 | begin
|
---|
536 | if (code[i] < mcFirstNonCap) and (x >= xFeature - 21) and
|
---|
537 | (x < xFeature - 21 + 12) then
|
---|
538 | begin
|
---|
539 | IncCap := code[i];
|
---|
540 | Dump(offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch *
|
---|
541 | i, 12, 12, 182, 172);
|
---|
542 | SmartInvalidate;
|
---|
543 | end
|
---|
544 | else if (x >= xFeature - 9) and (x < xFeature - 9 + 12) then
|
---|
545 | begin
|
---|
546 | DecCap := code[i];
|
---|
547 | if code[i] < mcFirstNonCap then
|
---|
548 | Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch *
|
---|
549 | i, 12, 12, 182, 159)
|
---|
550 | else
|
---|
551 | Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch *
|
---|
552 | i, 12, 12, 182, 185 + 13 * MyRO.DevModel.Cap[code[i]]);
|
---|
553 | SmartInvalidate;
|
---|
554 | end;
|
---|
555 | end;
|
---|
556 | end;
|
---|
557 | end;
|
---|
558 | end;
|
---|
559 |
|
---|
560 | procedure TDraftDlg.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
|
---|
561 | Shift: TShiftState; x, y: integer);
|
---|
562 | var
|
---|
563 | NewValue: integer;
|
---|
564 | begin
|
---|
565 | if IncCap >= 0 then
|
---|
566 | begin
|
---|
567 | NewValue := MyRO.DevModel.Cap[IncCap] + 1;
|
---|
568 | Server(sSetDevModelCap + NewValue shl 4, me, IncCap, nil^);
|
---|
569 | MyModel[MyRO.nModel] := MyRO.DevModel;
|
---|
570 | InitMyModel(MyRO.nModel, false);
|
---|
571 | SmartUpdateContent;
|
---|
572 | IncCap := -1;
|
---|
573 | end
|
---|
574 | else if DecCap >= 0 then
|
---|
575 | begin
|
---|
576 | if (DecCap >= mcFirstNonCap) or (MyRO.DevModel.Cap[DecCap] > 0) then
|
---|
577 | begin
|
---|
578 | NewValue := MyRO.DevModel.Cap[DecCap] - 1;
|
---|
579 | if DecCap >= mcFirstNonCap then
|
---|
580 | NewValue := -NewValue;
|
---|
581 | Server(sSetDevModelCap + NewValue shl 4, me, DecCap, nil^);
|
---|
582 | MyModel[MyRO.nModel] := MyRO.DevModel;
|
---|
583 | InitMyModel(MyRO.nModel, false);
|
---|
584 | end;
|
---|
585 | SmartUpdateContent;
|
---|
586 | DecCap := -1;
|
---|
587 | end;
|
---|
588 | end;
|
---|
589 |
|
---|
590 | procedure TDraftDlg.OKBtnClick(Sender: TObject);
|
---|
591 | begin
|
---|
592 | ModalResult := mrOK;
|
---|
593 | end;
|
---|
594 |
|
---|
595 | end.
|
---|