source: tags/1.3.8/LocalPlayer/Wonders.pas

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