source: trunk/LocalPlayer/Wonders.pas@ 485

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