source: trunk/LocalPlayer/Wonders.pas@ 167

Last change on this file since 167 was 156, checked in by chronos, 7 years ago
  • Modified: Improved wonders dialog code readability.
File size: 11.1 KB
Line 
1{$INCLUDE Switches.inc}
2unit Wonders;
3
4interface
5
6uses
7 ScreenTools, BaseWin, Protocol, LCLIntf, LCLType, SysUtils, Classes, Graphics,
8 Controls, Forms, ButtonB;
9
10type
11
12 { TWondersDlg }
13
14 TWondersDlg = class(TBufferedDrawDlg)
15 CloseBtn: TButtonB;
16 procedure FormCreate(Sender: TObject);
17 procedure CloseBtnClick(Sender: TObject);
18 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
19 procedure FormShow(Sender: TObject);
20 procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
21 Shift: TShiftState; X, Y: Integer);
22 private
23 Selection: Integer;
24 Center: TPoint;
25 procedure DarkIcon(i: Integer);
26 procedure Glow(i, GlowColor: Integer);
27 procedure PaintBackgroundShape;
28 public
29 procedure OffscreenPaint; override;
30 procedure ShowNewContent(NewMode: Integer);
31 end;
32
33var
34 WondersDlg: TWondersDlg;
35
36
37implementation
38
39uses
40 Term, ClientTools, Help, Tribes;
41
42{$R *.lfm}
43
44const
45 RingPosition: array [0 .. 20] of TPoint = (
46 (X: -80; Y: -32), // Pyramids
47 (X: 80; Y: -32), // Zeus
48 (X: 0; Y: -64), // Gardens
49 (X: 0; Y: 0), // Colossus
50 (X: 0; Y: 64), // Lighthouse
51 (X: -80; Y: 32), // GrLibrary
52 (X: -90; Y: 114), // Oracle
53 (X: 80; Y: 32), // Sun
54 (X: 90; Y: -114), // Leo
55 (X: -180; Y: 0), // Magellan
56 (X: 90; Y: 114), // Mich
57 (X: 0; Y: 0), // {11;}
58 (X: 180; Y: 0), // Newton
59 (X: -90; Y: -114), // Bach
60 (X: 0; Y: 0), // {14;}
61 (X: -160; Y: -64), // Liberty
62 (X: 0; Y: 128), // Eiffel
63 (X: 160; Y: -64), // Hoover
64 (X: -160; Y: 64), // Shinkansen
65 (X: 0; Y: -128), // Manhattan
66 (X: 160; Y: 64) // Mir
67 );
68
69procedure TWondersDlg.FormCreate(Sender: TObject);
70begin
71 Canvas.Font.Assign(UniFont[ftNormal]);
72 Canvas.Brush.Style := bsClear;
73 InitButtons;
74end;
75
76procedure TWondersDlg.FormShow(Sender: TObject);
77begin
78 Selection := -1;
79 OffscreenPaint;
80end;
81
82procedure TWondersDlg.ShowNewContent(NewMode: Integer);
83begin
84 inherited ShowNewContent(NewMode);
85end;
86
87procedure TWondersDlg.PaintBackgroundShape;
88const
89 darken = 24;
90 // space=pi/120;
91 amax0 = 15734; // 1 shl 16*tan(pi/12-space);
92 amin1 = 19413; // 1 shl 16*tan(pi/12+space);
93 amax1 = 62191; // 1 shl 16*tan(pi/4-space);
94 amin2 = 69061; // 1 shl 16*tan(pi/4+space);
95 amax2 = 221246; // 1 shl 16*tan(5*pi/12-space);
96 amin3 = 272977; // 1 shl 16*tan(5*pi/12+space);
97var
98 X: Integer;
99 Y: Integer;
100 ax: Integer;
101 R: Integer;
102 I: Integer;
103 C: Integer;
104 Ch: Integer;
105 Line: array [0..1] of TPixelPointer;
106begin
107 Offscreen.BeginUpdate;
108 Line[0].Init(Offscreen);
109 Line[1].Init(Offscreen);
110 for Y := 0 to 127 do begin
111 for X := 0 to 179 do begin
112 r := X * X * (32 * 32) + Y * Y * (45 * 45);
113 ax := ((1 shl 16 div 32) * 45) * Y;
114 if (r < 8 * 128 * 180 * 180) and
115 ((r >= 32 * 64 * 90 * 90) and (ax < amax2 * X) and
116 ((ax < amax0 * X) or (ax > amin2 * X)) or (ax > amin1 * X) and
117 ((ax < amax1 * X) or (ax > amin3 * X))) then
118 for i := 0 to 1 do
119 for ch := 0 to 2 do begin
120 Line[0].SetXY(Center.X + X, Center.Y + Y);
121 Line[1].SetXY(Center.X + X, Center.Y - 1 - Y);
122 c := Line[i].Pixel^.Planes[ch] - darken;
123 if c < 0 then Line[i].Pixel^.Planes[ch] := 0
124 else Line[i].Pixel^.Planes[ch] := c;
125 Line[0].SetXY(Center.X - 1 - X, Center.Y + Y);
126 Line[1].SetXY(Center.X - 1 - X, Center.Y - 1 - Y);
127 c := Line[i].Pixel^.Planes[ch] - darken;
128 if c < 0 then Line[i].Pixel^.Planes[ch] := 0
129 else Line[i].Pixel^.Planes[ch] := c;
130 end;
131 end;
132 end;
133 Offscreen.EndUpdate;
134end;
135
136procedure TWondersDlg.DarkIcon(i: Integer);
137var
138 X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer;
139 Src, Dst: TPixelPointer;
140begin
141 Offscreen.BeginUpdate;
142 x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i].X;
143 y0Dst := ClientHeight div 2 - ySizeBig div 2 + RingPosition[i].Y;
144 x0Src := (i mod 7) * xSizeBig;
145 y0Src := (i div 7 + SystemIconLines) * ySizeBig;
146 Src.Init(BigImp, x0Src, y0Src);
147 Dst.Init(Offscreen, x0Dst, y0Dst);
148 for Y := 0 to ySizeBig - 1 do begin
149 for X := 0 to xSizeBig - 1 do begin
150 Darken := ((255 - Src.Pixel^.B) * 3 + (255 - Src.Pixel^.G) *
151 15 + (255 - Src.Pixel^.R) * 9) div 128;
152 for ch := 0 to 2 do begin
153 c := Dst.Pixel^.Planes[ch] - Darken;
154 if c < 0 then Dst.Pixel^.Planes[ch] := 0
155 else Dst.Pixel^.Planes[ch] := c;
156 end;
157 Src.NextPixel;
158 Dst.NextPixel;
159 end;
160 Src.NextLine;
161 Dst.NextLine;
162 end;
163 Offscreen.EndUpdate;
164end;
165
166procedure TWondersDlg.Glow(i, GlowColor: Integer);
167begin
168 GlowFrame(Offscreen,
169 ClientWidth div 2 - xSizeBig div 2 + RingPosition[i].X,
170 ClientHeight div 2 - ySizeBig div 2 + RingPosition[i].Y,
171 xSizeBig, ySizeBig, GlowColor);
172end;
173
174procedure TWondersDlg.OffscreenPaint;
175var
176 I: Integer;
177 HaveWonder: Boolean;
178 S: string;
179begin
180 if (OffscreenUser <> nil) and (OffscreenUser <> Self) then
181 OffscreenUser.Update;
182 // complete working with old owner to prevent rebound
183 OffscreenUser := Self;
184
185 Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
186 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2);
187 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
188 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
189 MainTexture.clBevelLight, MainTexture.clBevelShade);
190 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
191 MainTexture.clBevelLight, MainTexture.clBevelShade);
192 Corner(Offscreen.Canvas, 1, 1, 0, MainTexture);
193 Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture);
194 Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture);
195 Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
196
197 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture);
198
199 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
200 S := Phrases.Lookup('TITLE_WONDERS');
201 RisedTextOut(Offscreen.Canvas,
202 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, S)) div 2 - 1, 7, S);
203 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
204
205 Center := Point(ClientWidth div 2, ClientHeight div 2);
206
207 PaintBackgroundShape;
208
209 for I := 0 to 20 do
210 if Imp[I].Preq <> preNA then
211 begin
212 case MyRO.Wonder[I].CityID of
213 - 1: // not built yet
214 begin
215 Fill(Offscreen.Canvas, Center.X - xSizeBig div 2 + RingPosition[I].X - 3,
216 Center.Y - ySizeBig div 2 + RingPosition[I].Y - 3, xSizeBig + 6,
217 ySizeBig + 6, (wMaintexture - ClientWidth) div 2,
218 (hMaintexture - ClientHeight) div 2);
219 DarkIcon(I);
220 end;
221 -2: // destroyed
222 begin
223 Glow(I, $000000);
224 end;
225 else
226 begin
227 if MyRO.Wonder[I].EffectiveOwner >= 0 then
228 Glow(I, Tribe[MyRO.Wonder[I].EffectiveOwner].Color)
229 else
230 Glow(I, $000000);
231 end;
232 end;
233 end;
234
235 HaveWonder := False;
236 for I := 0 to 20 do
237 if Imp[I].Preq <> preNA then
238 begin
239 case MyRO.Wonder[I].CityID of
240 - 1: // not built yet
241 begin
242 Fill(Offscreen.Canvas, Center.X - xSizeBig div 2 + RingPosition[I].X - 3,
243 Center.Y - ySizeBig div 2 + RingPosition[I].Y - 3, xSizeBig + 6,
244 ySizeBig + 6, (wMaintexture - ClientWidth) div 2,
245 (hMaintexture - ClientHeight) div 2);
246 DarkIcon(I);
247 end;
248 -2: // destroyed
249 begin
250 HaveWonder := True;
251 BitBlt(Offscreen.Canvas.Handle,
252 Center.X - xSizeBig div 2 + RingPosition[I].X,
253 Center.Y - ySizeBig div 2 + RingPosition[I].Y, xSizeBig,
254 ySizeBig, BigImp.Canvas.Handle, 0, (SystemIconLines + 3) *
255 ySizeBig, SRCCOPY);
256 end;
257 else
258 begin
259 HaveWonder := True;
260 BitBlt(Offscreen.Canvas.Handle,
261 Center.X - xSizeBig div 2 + RingPosition[I].X,
262 Center.Y - ySizeBig div 2 + RingPosition[I].Y, xSizeBig, ySizeBig,
263 BigImp.Canvas.Handle, (I mod 7) * xSizeBig,
264 (I div 7 + SystemIconLines) * ySizeBig, SRCCOPY);
265 end;
266 end;
267 end;
268
269 if not HaveWonder then
270 begin
271 S := Phrases.Lookup('NOWONDER');
272 RisedTextOut(Offscreen.Canvas,
273 Center.X - BiColorTextWidth(Offscreen.Canvas, S) div 2,
274 Center.Y - Offscreen.Canvas.TextHeight(S) div 2, S);
275 end;
276
277 MarkUsedOffscreen(ClientWidth, ClientHeight);
278end; { OffscreenPaint }
279
280procedure TWondersDlg.CloseBtnClick(Sender: TObject);
281begin
282 Close;
283end;
284
285procedure TWondersDlg.FormMouseMove(Sender: TObject; Shift: TShiftState;
286 X, Y: Integer);
287var
288 I, OldSelection: Integer;
289 S: string;
290begin
291 OldSelection := Selection;
292 Selection := -1;
293 for I := 0 to 20 do
294 if (Imp[I].Preq <> preNA) and
295 (X >= Center.X - xSizeBig div 2 + RingPosition[I].X) and
296 (X < Center.X + xSizeBig div 2 + RingPosition[I].X) and
297 (Y >= Center.Y - ySizeBig div 2 + RingPosition[I].Y) and
298 (Y < Center.Y + ySizeBig div 2 + RingPosition[I].Y) then
299 begin
300 Selection := I;
301 Break;
302 end;
303 if Selection <> OldSelection then
304 begin
305 Fill(Canvas, 9, ClientHeight - 3 - 46, ClientWidth - 18, 44,
306 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2);
307 if Selection >= 0 then
308 begin
309 if MyRO.Wonder[Selection].CityID = -1 then
310 begin // not built yet
311 { S:=Phrases.Lookup('IMPROVEMENTS',Selection);
312 Canvas.Font.Color:=$000000;
313 Canvas.TextOut(
314 (ClientWidth-BiColorTextWidth(Canvas,S)) div 2+1,
315 ClientHeight-3-36+1, S);
316 Canvas.Font.Color:=MainTexture.clBevelLight;
317 Canvas.TextOut(
318 (ClientWidth-BiColorTextWidth(Canvas,S)) div 2,
319 ClientHeight-3-36, S); }
320 end
321 else
322 begin
323 S := Phrases.Lookup('IMPROVEMENTS', Selection);
324 if MyRO.Wonder[Selection].CityID <> -2 then
325 S := Format(Phrases.Lookup('WONDEROF'),
326 [S, CityName(MyRO.Wonder[Selection].CityID)]);
327 LoweredTextOut(Canvas, -1, MainTexture,
328 (ClientWidth - BiColorTextWidth(Canvas, S)) div 2,
329 ClientHeight - 3 - 36 - 10, S);
330 if MyRO.Wonder[Selection].CityID = -2 then
331 S := Phrases.Lookup('DESTROYED')
332 else if MyRO.Wonder[Selection].EffectiveOwner < 0 then
333 S := Phrases.Lookup('EXPIRED')
334 else
335 S := Tribe[MyRO.Wonder[Selection].EffectiveOwner].TPhrase('WONDEROWNER');
336 LoweredTextOut(Canvas, -1, MainTexture,
337 (ClientWidth - BiColorTextWidth(Canvas, S)) div 2,
338 ClientHeight - 3 - 36 + 10, S);
339 end;
340 end;
341 end;
342end;
343
344procedure TWondersDlg.FormMouseDown(Sender: TObject; Button: TMouseButton;
345 Shift: TShiftState; X, Y: Integer);
346begin
347 if Selection >= 0 then
348 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Selection);
349end;
350
351end.
Note: See TracBrowser for help on using the repository browser.