source: tags/1.3.6/LocalPlayer/Wonders.pas

Last change on this file was 565, checked in by chronos, 7 months ago
  • Modified: Start form changed to use Offscreen bitmap for drawing as Qt5 doesn't support copying from form canvas.
File size: 11.8 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 public
32 procedure ShowNewContent(NewMode: TWindowMode);
33 end;
34
35
36implementation
37
38uses
39 {$IFDEF DPI}Dpi.PixelPointer,{$ELSE}PixelPointer,{$ENDIF}
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 := TBrushStyle.bsClear;
73 InitButtons;
74end;
75
76procedure TWondersDlg.FormShow(Sender: TObject);
77begin
78 Caption := Phrases.Lookup('TITLE_WONDERS');
79 Selection := -1;
80 OffscreenPaint;
81end;
82
83procedure TWondersDlg.ShowNewContent(NewMode: TWindowMode);
84begin
85 inherited ShowNewContent(NewMode);
86end;
87
88procedure TWondersDlg.PaintBackgroundShape;
89const
90 Darken = 24;
91 // space = Pi / 120;
92 amax0 = 15734; // 1 shl 16*tan(pi/12-space);
93 amin1 = 19413; // 1 shl 16*tan(pi/12+space);
94 amax1 = 62191; // 1 shl 16*tan(pi/4-space);
95 amin2 = 69061; // 1 shl 16*tan(pi/4+space);
96 amax2 = 221246; // 1 shl 16*tan(5*pi/12-space);
97 amin3 = 272977; // 1 shl 16*tan(5*pi/12+space);
98var
99 X: Integer;
100 Y: Integer;
101 ax: Integer;
102 R: Int64;
103 C: Integer;
104 Ch: Integer;
105 Line: array [0..3] of TPixelPointer;
106 Width: Integer;
107 Height: Integer;
108begin
109 Width := ScaleToNative(180);
110 Height := ScaleToNative(128);
111 Offscreen.BeginUpdate;
112 Line[0] := TPixelPointer.Create(Offscreen, ScaleToNative(Center.X), ScaleToNative(Center.Y));
113 Line[1] := TPixelPointer.Create(Offscreen, ScaleToNative(Center.X), ScaleToNative(Center.Y) - 1);
114 Line[2] := TPixelPointer.Create(Offscreen, ScaleToNative(Center.X) - 1, ScaleToNative(Center.Y));
115 Line[3] := TPixelPointer.Create(Offscreen, ScaleToNative(Center.X) - 1, ScaleToNative(Center.Y) - 1);
116 for Y := 0 to Height - 1 do begin
117 for X := 0 to Width - 1 do begin
118 R := X * X * ((Height div 4) * (Height div 4)) + Y * Y * ((Width div 4) * (Width div 4));
119 ax := ((1 shl 16 div (Height div 4)) * (Width div 4)) * Y;
120 if (R < ScaleToNative(8) * Height * Width * Width) and
121 ((R >= (Height div 4) * (Height div 2) * (Width div 2) * (Width div 2)) and (ax < amax2 * X) and
122 ((ax < amax0 * X) or (ax > amin2 * X)) or (ax > amin1 * X) and
123 ((ax < amax1 * X) or (ax > amin3 * X))) then begin
124 for ch := 0 to 2 do begin
125 C := Line[0].PixelPlane[ch] - Darken;
126 if C < 0 then Line[0].PixelPlane[ch] := 0
127 else Line[0].PixelPlane[ch] := C;
128 C := Line[1].PixelPlane[ch] - Darken;
129 if C < 0 then Line[1].PixelPlane[ch] := 0
130 else Line[1].PixelPlane[ch] := C;
131 C := Line[2].PixelPlane[ch] - Darken;
132 if C < 0 then Line[2].PixelPlane[ch] := 0
133 else Line[2].PixelPlane[ch] := C;
134 C := Line[3].PixelPlane[ch] - Darken;
135 if C < 0 then Line[3].PixelPlane[ch] := 0
136 else Line[3].PixelPlane[ch] := C;
137 end;
138 end;
139 Line[0].NextPixel;
140 Line[1].NextPixel;
141 Line[2].PreviousPixel;
142 Line[3].PreviousPixel;
143 end;
144 Line[0].NextLine;
145 Line[1].PreviousLine;
146 Line[2].NextLine;
147 Line[3].PreviousLine;
148 end;
149 Offscreen.EndUpdate;
150end;
151
152procedure TWondersDlg.DarkIcon(I: Integer);
153var
154 X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, C: Integer;
155 Src, Dst: TPixelPointer;
156begin
157 Offscreen.BeginUpdate;
158 x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[I].X;
159 y0Dst := ClientHeight div 2 - ySizeBig div 2 + RingPosition[I].Y;
160 x0Src := (I mod 7) * xSizeBig;
161 y0Src := (I div 7 + SystemIconLines) * ySizeBig;
162 Src := TPixelPointer.Create(BigImp, ScaleToNative(x0Src), ScaleToNative(y0Src));
163 Dst := TPixelPointer.Create(Offscreen, ScaleToNative(x0Dst), ScaleToNative(y0Dst));
164 for Y := 0 to ScaleToNative(ySizeBig) - 1 do begin
165 for X := 0 to ScaleToNative(xSizeBig) - 1 do begin
166 Darken := ((255 - Src.PixelB) * 3 + (255 - Src.PixelG) *
167 15 + (255 - Src.PixelR) * 9) div 128;
168 for ch := 0 to 2 do begin
169 C := Dst.PixelPlane[ch] - Darken;
170 if C < 0 then Dst.PixelPlane[ch] := 0
171 else Dst.PixelPlane[ch] := C;
172 end;
173 Src.NextPixel;
174 Dst.NextPixel;
175 end;
176 Src.NextLine;
177 Dst.NextLine;
178 end;
179 Offscreen.EndUpdate;
180end;
181
182procedure TWondersDlg.Glow(I, GlowColor: Integer);
183begin
184 GlowFrame(Offscreen,
185 ClientWidth div 2 - xSizeBig div 2 + RingPosition[I].X,
186 ClientHeight div 2 - ySizeBig div 2 + RingPosition[I].Y,
187 xSizeBig, ySizeBig, GlowColor);
188end;
189
190procedure TWondersDlg.OffscreenPaint;
191var
192 I: Integer;
193 HaveWonder: Boolean;
194 S: string;
195begin
196 inherited;
197
198 Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
199 (Maintexture.Width - ClientWidth) div 2, (Maintexture.Height - ClientHeight) div 2);
200 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
201 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
202 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
203 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
204 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
205 Corner(Offscreen.Canvas, 1, 1, 0, MainTexture);
206 Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture);
207 Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture);
208 Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
209
210 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture);
211
212 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
213 S := Phrases.Lookup('TITLE_WONDERS');
214 RisedTextOut(Offscreen.Canvas,
215 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, S)) div 2 - 1, 7, S);
216 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
217
218 Center := Point(ClientWidth div 2, ClientHeight div 2);
219
220 PaintBackgroundShape;
221
222 // Draw all bitmaps first
223 HaveWonder := False;
224 for I := 0 to 20 do begin
225 if Imp[I].Preq <> preNA then begin
226 case MyRO.Wonder[I].CityID of
227 WonderNotBuiltYet: begin
228 Fill(Offscreen.Canvas, Center.X - xSizeBig div 2 + RingPosition[I].X - 3,
229 Center.Y - ySizeBig div 2 + RingPosition[I].Y - 3, xSizeBig + 6,
230 ySizeBig + 6, (Maintexture.Width - ClientWidth) div 2,
231 (Maintexture.Height - ClientHeight) div 2);
232 end;
233 WonderDestroyed: begin
234 HaveWonder := True;
235 BitBltBitmap(Offscreen,
236 Center.X - xSizeBig div 2 + RingPosition[I].X,
237 Center.Y - ySizeBig div 2 + RingPosition[I].Y, xSizeBig,
238 ySizeBig, BigImp, 0, (SystemIconLines + 3) *
239 ySizeBig);
240 end;
241 else begin
242 HaveWonder := True;
243 BitBltBitmap(Offscreen,
244 Center.X - xSizeBig div 2 + RingPosition[I].X,
245 Center.Y - ySizeBig div 2 + RingPosition[I].Y, xSizeBig, ySizeBig,
246 BigImp, (I mod 7) * xSizeBig,
247 (I div 7 + SystemIconLines) * ySizeBig);
248 end;
249 end;
250 end;
251 end;
252
253 // Do direct pixel postprocessing separately to avoid bitmap copying in memory
254 Offscreen.Canvas.FillRect(0, 0, 0, 0);
255 Offscreen.BeginUpdate;
256 for I := 0 to 20 do begin
257 if Imp[I].Preq <> preNA then begin
258 case MyRO.Wonder[I].CityID of
259 WonderNotBuiltYet: DarkIcon(I);
260 WonderDestroyed: Glow(I, $000000);
261 else begin
262 if MyRO.Wonder[I].EffectiveOwner >= 0 then
263 Glow(I, Tribe[MyRO.Wonder[I].EffectiveOwner].Color)
264 else Glow(I, $000000);
265 end;
266 end;
267 end;
268 end;
269 Offscreen.EndUpdate;
270
271 if not HaveWonder then
272 begin
273 S := Phrases.Lookup('NOWONDER');
274 RisedTextOut(Offscreen.Canvas,
275 Center.X - BiColorTextWidth(Offscreen.Canvas, S) div 2,
276 Center.Y - Offscreen.Canvas.TextHeight(S) div 2, S);
277 end;
278
279 MarkUsedOffscreen(ClientWidth, ClientHeight);
280end;
281
282procedure TWondersDlg.CloseBtnClick(Sender: TObject);
283begin
284 Close;
285end;
286
287procedure TWondersDlg.FormMouseMove(Sender: TObject; Shift: TShiftState;
288 X, Y: Integer);
289var
290 I, OldSelection: Integer;
291 S: string;
292begin
293 OldSelection := Selection;
294 Selection := -1;
295 for I := 0 to 20 do
296 if (Imp[I].Preq <> preNA) and
297 (X >= Center.X - xSizeBig div 2 + RingPosition[I].X) and
298 (X < Center.X + xSizeBig div 2 + RingPosition[I].X) and
299 (Y >= Center.Y - ySizeBig div 2 + RingPosition[I].Y) and
300 (Y < Center.Y + ySizeBig div 2 + RingPosition[I].Y) then
301 begin
302 Selection := I;
303 Break;
304 end;
305 if Selection <> OldSelection then
306 begin
307 Fill(Canvas, 9, ClientHeight - 3 - 46, ClientWidth - 18, 44,
308 (Maintexture.Width - ClientWidth) div 2, (Maintexture.Height - ClientHeight) div 2);
309 if Selection >= 0 then
310 begin
311 if MyRO.Wonder[Selection].CityID = WonderNotBuiltYet then
312 begin // not built yet
313 { S:=Phrases.Lookup('IMPROVEMENTS',Selection);
314 Canvas.Font.Color:=$000000;
315 Canvas.TextOut(
316 (ClientWidth-BiColorTextWidth(Canvas,S)) div 2+1,
317 ClientHeight-3-36+1, S);
318 Canvas.Font.Color:=MainTexture.ColorBevelLight;
319 Canvas.TextOut(
320 (ClientWidth-BiColorTextWidth(Canvas,S)) div 2,
321 ClientHeight-3-36, S); }
322 end
323 else
324 begin
325 S := Phrases.Lookup('IMPROVEMENTS', Selection);
326 if MyRO.Wonder[Selection].CityID <> WonderDestroyed then
327 S := Format(Phrases.Lookup('WONDEROF'),
328 [S, CityName(MyRO.Wonder[Selection].CityID)]);
329 LoweredTextOut(Canvas, -1, MainTexture,
330 (ClientWidth - BiColorTextWidth(Canvas, S)) div 2,
331 ClientHeight - 3 - 36 - 10, S);
332 if MyRO.Wonder[Selection].CityID = WonderDestroyed then
333 S := Phrases.Lookup('DESTROYED')
334 else if MyRO.Wonder[Selection].EffectiveOwner < 0 then
335 S := Phrases.Lookup('EXPIRED')
336 else
337 S := Tribe[MyRO.Wonder[Selection].EffectiveOwner].TPhrase('WONDEROWNER');
338 LoweredTextOut(Canvas, -1, MainTexture,
339 (ClientWidth - BiColorTextWidth(Canvas, S)) div 2,
340 ClientHeight - 3 - 36 + 10, S);
341 end;
342 end;
343 end;
344end;
345
346procedure TWondersDlg.FormMouseDown(Sender: TObject; Button: TMouseButton;
347 Shift: TShiftState; X, Y: Integer);
348begin
349 if Selection >= 0 then
350 MainScreen.HelpDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), hkImp, Selection);
351end;
352
353end.
Note: See TracBrowser for help on using the repository browser.