source: branches/delphi/LocalPlayer/Wonders.pas

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