source: tags/1.3.1/LocalPlayer/Diagram.pas

Last change on this file was 442, checked in by chronos, 2 years ago
  • Modified: Code cleanup.
File size: 11.5 KB
Line 
1{$INCLUDE Switches.inc}
2unit Diagram;
3
4interface
5
6uses
7 BaseWin, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
8 ButtonB, Menus;
9
10type
11 TDiaDlg = class(TFramedDlg)
12 CloseBtn: TButtonB;
13 ToggleBtn: TButtonB;
14 Popup: TPopupMenu;
15 procedure CloseBtnClick(Sender: TObject);
16 procedure FormPaint(Sender: TObject);
17 procedure FormShow(Sender: TObject);
18 procedure FormCreate(Sender: TObject);
19 procedure ToggleBtnClick(Sender: TObject);
20 procedure PlayerClick(Sender: TObject);
21 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
22
23 public
24 procedure OffscreenPaint; override;
25 procedure ShowNewContent_Charts(NewMode: TWindowMode);
26 procedure ShowNewContent_Ship(NewMode: TWindowMode; p: integer = -1);
27
28 private
29 Kind: (dkChart, dkShip);
30 Player, Mode: integer;
31 end;
32
33var
34 DiaDlg: TDiaDlg;
35
36procedure PaintColonyShip(canvas: TCanvas; Player, Left, Width, Top: integer);
37
38implementation
39
40uses
41 Protocol, ScreenTools, ClientTools, Tribes;
42
43{$R *.lfm}
44
45const
46 Border = 24;
47 RoundPixels: array [0 .. nStat - 1] of integer = (0, 0, 0, 5, 5, 5);
48
49 yArea = 48;
50 xComp: array [0 .. 5] of integer = (-60, -28, 4, 4, 36, 68);
51 yComp: array [0 .. 5] of integer = (-40, -40, -79, -1, -40, -40);
52 xPow: array [0 .. 3] of integer = (-116, -116, -116, -116);
53 yPow: array [0 .. 3] of integer = (-28, 0, -44, 16);
54 xHab: array [0 .. 1] of integer = (23, 23);
55 yHab: array [0 .. 1] of integer = (-81, 1);
56
57procedure PaintColonyShip(canvas: TCanvas; Player, Left, Width, Top: integer);
58var
59 i, x, r, nComp, nPow, nHab: integer;
60begin
61 Canvas.Brush.Color := $000000;
62 Canvas.FillRect(Rect(Left, Top, Left + Width, Top + 200));
63 Canvas.Brush.Style := bsClear;
64 ScreenTools.Frame(canvas, Left - 1, Top - 1, Left + Width, Top + 200,
65 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
66 RFrame(canvas, Left - 2, Top - 2, Left + Width + 1, Top + 200 + 1,
67 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
68
69 // stars
70 DelphiRandSeed := Player * 11111;
71 for i := 1 to Width - 16 do
72 begin
73 x := DelphiRandom((Width - 16) * 200);
74 r := DelphiRandom(13) + 28;
75 Canvas.Pixels[x div 200 + 8, x mod 200 + Top] :=
76 (r * r * r * r div 10001) * $10101;
77 end;
78
79 nComp := MyRO.Ship[Player].Parts[spComp];
80 nPow := MyRO.Ship[Player].Parts[spPow];
81 nHab := MyRO.Ship[Player].Parts[spHab];
82 if nComp > 6 then
83 nComp := 6;
84 if nPow > 4 then
85 nPow := 4;
86 if nHab > 2 then
87 nHab := 2;
88 for i := 0 to nHab - 1 do
89 Sprite(canvas, HGrSystem2, Left + Width div 2 + xHab[i],
90 Top + 100 + yHab[i], 80, 80, 34, 1);
91 for i := 0 to nComp - 1 do
92 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[i],
93 Top + 100 + yComp[i], 32, 80, 1, 1);
94 if nComp > 0 then
95 for i := 3 downto nPow do
96 Sprite(canvas, HGrSystem2, Left + Width div 2 + xPow[i] + 40,
97 Top + 100 + yPow[i], 16, 27, 1, 82);
98 for i := nPow - 1 downto 0 do
99 Sprite(canvas, HGrSystem2, Left + Width div 2 + xPow[i],
100 Top + 100 + yPow[i], 56, 28, 58, 82);
101 if (nComp < 3) and (nHab >= 1) then
102 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32 - 16,
103 Top + 100 + 7 + yComp[2], 16, 27, 1, 82);
104 if (nComp >= 3) and (nHab < 1) then
105 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32,
106 Top + 100 + 7 + yComp[2], 16, 27, 18, 82);
107 if (nComp < 4) and (nHab >= 2) then
108 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32 - 16,
109 Top + 100 + 46 + yComp[3], 16, 27, 1, 82);
110 if (nComp >= 4) and (nHab < 2) then
111 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32,
112 Top + 100 + 46 + yComp[3], 16, 27, 18, 82);
113 if (nComp <> 6) and (nComp <> 2) and not((nComp = 0) and (nPow < 1)) then
114 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
115 Top + 100 + 7 + yComp[nComp], 16, 27, 18, 82);
116 if (nComp <> 6) and (nComp <> 3) and not((nComp = 0) and (nPow < 2)) then
117 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
118 Top + 100 + 46 + yComp[nComp], 16, 27, 18, 82);
119 if nComp = 2 then
120 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3],
121 Top + 100 + 7 + yComp[3], 16, 27, 18, 82);
122 if nComp = 3 then
123 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[4],
124 Top + 100 + 7 + yComp[4], 16, 27, 18, 82);
125end;
126
127procedure TDiaDlg.FormCreate(Sender: TObject);
128begin
129 inherited;
130 TitleHeight := WideFrame + 20;
131 InnerHeight := Height - TitleHeight - NarrowFrame;
132 CaptionRight := CloseBtn.Left;
133 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width;
134 InitButtons;
135end;
136
137procedure TDiaDlg.CloseBtnClick(Sender: TObject);
138begin
139 Close;
140end;
141
142procedure TDiaDlg.OffscreenPaint;
143var
144 p, T, max, x, y, y0, Stop, r, RoundRange, LineStep: integer;
145 s: string;
146 List: ^TChart;
147
148 function Round(T: integer): integer;
149 var
150 n, i: integer;
151 begin
152 if T < RoundRange then
153 n := T
154 else
155 n := RoundRange;
156 result := 0;
157 for i := T - n to T do
158 inc(result, List[i]);
159 result := result div (n + 1);
160 end;
161
162 procedure ShareBar(x, y: integer; Cap: string; val0, val1: integer);
163 begin
164 LoweredTextOut(offscreen.canvas, -1, MainTexture, x - 2, y, Cap);
165 DLine(offscreen.canvas, x - 2, x + 169, y + 16, MainTexture.ColorTextShade,
166 MainTexture.ColorTextLight);
167 if val0 > 0 then
168 s := Format(Phrases.Lookup('SHARE'), [val0, val1])
169 else
170 s := '0';
171 RisedTextOut(offscreen.canvas,
172 x + 170 - BiColorTextWidth(offscreen.canvas, s), y, s);
173 end;
174
175begin
176 inherited;
177 if Kind = dkChart then
178 with offscreen.canvas do
179 begin
180 Font.Assign(UniFont[ftTiny]);
181 Font.Color := $808080;
182
183 RoundRange := RoundPixels[Mode] * (MyRO.Turn - 1)
184 div (InnerWidth - 2 * Border);
185
186 GetMem(List, 4 * (MyRO.Turn + 2));
187 if Mode = stExplore then
188 max := G.lx * G.ly
189 else
190 begin
191 max := -1;
192 for p := 0 to nPl - 1 do
193 if (G.Difficulty[p] > 0) and
194 (Server(sGetChart + Mode shl 4, me, p, List^) >= rExecuted) then
195 for T := 0 to MyRO.Turn - 1 do
196 begin
197 r := Round(T);
198 if r > max then
199 max := r;
200 end;
201 end;
202
203 Brush.Color := $000000;
204 FillRect(Rect(0, 0, InnerWidth, InnerHeight));
205 Brush.Style := bsClear;
206 Pen.Color := $606060;
207 MoveTo(Border, InnerHeight - Border);
208 LineTo(InnerWidth - Border, InnerHeight - Border);
209 if MyRO.Turn >= 800 then
210 LineStep := 200
211 else if MyRO.Turn >= 400 then
212 LineStep := 100
213 else
214 LineStep := 50;
215 for T := 0 to (MyRO.Turn - 1) div LineStep do
216 begin
217 x := Border + (InnerWidth - 2 * Border) * T *
218 LineStep div (MyRO.Turn - 1);
219 MoveTo(x, Border);
220 LineTo(x, InnerHeight - Border);
221 s := IntToStr(abs(TurnToYear(T * LineStep)));
222 Textout(x - TextWidth(s) div 2, Border - 16, s);
223 end;
224
225 y0 := 0;
226 if max > 0 then
227 begin
228 for p := 0 to nPl - 1 do
229 if (G.Difficulty[p] > 0) and
230 (Server(sGetChart + Mode shl 4, me, p, List^) >= rExecuted) then
231 begin
232 Pen.Color := Tribe[p].Color;
233 Stop := MyRO.Turn - 1;
234 while (Stop > 0) and (List[Stop] = 0) do
235 dec(Stop);
236 for T := 0 to Stop do
237 begin
238 r := Round(T);
239 x := Border + (InnerWidth - 2 * Border) * T div (MyRO.Turn - 1);
240 y := InnerHeight - Border - (InnerHeight - 2 * Border) *
241 r div max;
242 if T = 0 then
243 MoveTo(x, y)
244 // else if Mode=stTerritory then
245 // begin LineTo(x,y0); LineTo(x,y) end
246 else if RoundPixels[Mode] = 0 then
247 begin
248 if (y <> y0) or (T = Stop) then
249 LineTo(x, y)
250 end
251 else
252 LineTo(x, y);
253 y0 := y;
254 end;
255 end;
256 end;
257 FreeMem(List);
258 end
259 else
260 with offscreen.canvas do
261 begin
262 Font.Assign(UniFont[ftSmall]);
263 FillOffscreen(0, 0, InnerWidth, InnerHeight);
264
265 PaintColonyShip(offscreen.canvas, Player, 8, InnerWidth - 16, yArea);
266
267 ShareBar(InnerWidth div 2 - 85, InnerHeight - 62,
268 Phrases.Lookup('SHIPHAB'), MyRO.Ship[Player].Parts[spHab], 2);
269 ShareBar(InnerWidth div 2 - 85, InnerHeight - 43,
270 Phrases.Lookup('SHIPPOW'), MyRO.Ship[Player].Parts[spPow], 4);
271 ShareBar(InnerWidth div 2 - 85, InnerHeight - 24,
272 Phrases.Lookup('SHIPCOMP'), MyRO.Ship[Player].Parts[spComp], 6);
273 end;
274 MarkUsedOffscreen(InnerWidth, InnerHeight);
275end;
276
277procedure TDiaDlg.FormPaint(Sender: TObject);
278var
279 s: string;
280begin
281 inherited;
282 canvas.Font.Assign(UniFont[ftNormal]);
283 if Kind = dkChart then
284 s := Phrases.Lookup('DIAGRAM', Mode)
285 else
286 s := Tribe[Player].TPhrase('SHORTNAME');
287 LoweredTextOut(canvas, -1, MainTexture,
288 (ClientWidth - BiColorTextWidth(canvas, s)) div 2, 31, s);
289end;
290
291procedure TDiaDlg.FormShow(Sender: TObject);
292begin
293 if WindowMode = wmModal then
294 begin { center on screen }
295 Left := (Screen.Width - Width) div 2;
296 Top := (Screen.Height - Height) div 2;
297 end;
298 OffscreenPaint;
299end;
300
301procedure TDiaDlg.ShowNewContent_Charts(NewMode: TWindowMode);
302begin
303 Kind := dkChart;
304 Mode := stPop;
305 ToggleBtn.ButtonIndex := 15;
306 ToggleBtn.Hint := Phrases.Lookup('BTN_PAGE');
307 Caption := Phrases.Lookup('TITLE_DIAGRAMS');
308 inherited ShowNewContent(NewMode);
309end;
310
311procedure TDiaDlg.ShowNewContent_Ship(NewMode: TWindowMode; p: integer);
312begin
313 Kind := dkShip;
314 if p < 0 then
315 begin
316 Player := me;
317 while MyRO.Ship[Player].Parts[spComp] + MyRO.Ship[Player].Parts[spPow] +
318 MyRO.Ship[Player].Parts[spHab] = 0 do
319 Player := (Player + 1) mod nPl;
320 end
321 else
322 Player := p;
323 ToggleBtn.ButtonIndex := 28;
324 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT');
325 Caption := Phrases.Lookup('TITLE_SHIPS');
326 inherited ShowNewContent(NewMode);
327end;
328
329procedure TDiaDlg.ToggleBtnClick(Sender: TObject);
330var
331 p1: integer;
332 m: TMenuItem;
333begin
334 if Kind = dkChart then
335 begin
336 Mode := (Mode + 1) mod nStat;
337 OffscreenPaint;
338 Invalidate;
339 end
340 else
341 begin
342 EmptyMenu(Popup.Items);
343 for p1 := 0 to nPl - 1 do
344 if MyRO.Ship[p1].Parts[spComp] + MyRO.Ship[p1].Parts[spPow] +
345 MyRO.Ship[p1].Parts[spHab] > 0 then
346 begin
347 m := TMenuItem.Create(Popup);
348 m.RadioItem := true;
349 m.Caption := Tribe[p1].TPhrase('SHORTNAME');
350 m.Tag := p1;
351 m.OnClick := PlayerClick;
352 if p1 = Player then
353 m.Checked := true;
354 Popup.Items.Add(m);
355 end;
356 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height);
357 end;
358end;
359
360procedure TDiaDlg.PlayerClick(Sender: TObject);
361begin
362 ShowNewContent_Ship(FWindowMode, TComponent(Sender).Tag);
363end;
364
365procedure TDiaDlg.FormKeyDown(Sender: TObject; var Key: word;
366 Shift: TShiftState);
367begin
368 if (Key = VK_F6) and (Kind = dkChart) then // my key
369 ToggleBtnClick(nil)
370 else if (Key = VK_F8) and (Kind = dkShip) then // my other key
371 else
372 inherited;
373end;
374
375end.
Note: See TracBrowser for help on using the repository browser.