source: tags/1.3.6/LocalPlayer/Diagram.pas

Last change on this file was 622, checked in by chronos, 2 months ago
  • Modified: Show windows by default on primary screen if multiple monitors present.
File size: 11.5 KB
Line 
1{$INCLUDE Switches.inc}
2unit Diagram;
3
4interface
5
6uses
7 BaseWin, LCLIntf, LCLType, SysUtils, Classes, ButtonB,
8{$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.Menus{$ELSE}
9Graphics, Controls, Forms, Menus{$ENDIF};
10
11type
12 TDiagramKind = (dkChart, dkShip);
13
14 TDiaDlg = class(TFramedDlg)
15 CloseBtn: TButtonB;
16 ToggleBtn: TButtonB;
17 Popup: TPopupMenu;
18 procedure CloseBtnClick(Sender: TObject);
19 procedure FormPaint(Sender: TObject);
20 procedure FormShow(Sender: TObject);
21 procedure FormCreate(Sender: TObject);
22 procedure ToggleBtnClick(Sender: TObject);
23 procedure PlayerClick(Sender: TObject);
24 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
25 public
26 procedure OffscreenPaint; override;
27 procedure ShowNewContent_Charts(NewMode: TWindowMode);
28 procedure ShowNewContent_Ship(NewMode: TWindowMode; P: Integer = -1);
29 private
30 Kind: TDiagramKind;
31 Player: Integer;
32 Mode: Integer;
33 end;
34
35procedure PaintColonyShip(Canvas: TCanvas; Player, Left, Width, Top: Integer);
36
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 := TBrushStyle.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 := TBrushStyle.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 CenterToScreen;
294 OffscreenPaint;
295end;
296
297procedure TDiaDlg.ShowNewContent_Charts(NewMode: TWindowMode);
298begin
299 Kind := dkChart;
300 Mode := stPop;
301 ToggleBtn.ButtonIndex := 15;
302 ToggleBtn.Hint := Phrases.Lookup('BTN_PAGE');
303 Caption := Phrases.Lookup('TITLE_DIAGRAMS');
304 inherited ShowNewContent(NewMode);
305end;
306
307procedure TDiaDlg.ShowNewContent_Ship(NewMode: TWindowMode; P: Integer);
308begin
309 Kind := dkShip;
310 if P < 0 then
311 begin
312 Player := Me;
313 while MyRO.Ship[Player].Parts[spComp] + MyRO.Ship[Player].Parts[spPow] +
314 MyRO.Ship[Player].Parts[spHab] = 0 do
315 Player := (Player + 1) mod nPl;
316 end
317 else
318 Player := P;
319 ToggleBtn.ButtonIndex := 28;
320 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT');
321 Caption := Phrases.Lookup('TITLE_SHIPS');
322 inherited ShowNewContent(NewMode);
323end;
324
325procedure TDiaDlg.ToggleBtnClick(Sender: TObject);
326var
327 p1: Integer;
328 M: TMenuItem;
329begin
330 if Kind = dkChart then
331 begin
332 Mode := (Mode + 1) mod nStat;
333 OffscreenPaint;
334 Invalidate;
335 end
336 else
337 begin
338 EmptyMenu(Popup.Items);
339 for p1 := 0 to nPl - 1 do
340 if MyRO.Ship[p1].Parts[spComp] + MyRO.Ship[p1].Parts[spPow] +
341 MyRO.Ship[p1].Parts[spHab] > 0 then
342 begin
343 M := TMenuItem.Create(Popup);
344 M.RadioItem := True;
345 M.Caption := Tribe[p1].TPhrase('SHORTNAME');
346 M.Tag := p1;
347 M.OnClick := PlayerClick;
348 if p1 = Player then
349 M.Checked := True;
350 Popup.Items.Add(M);
351 end;
352 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height);
353 end;
354end;
355
356procedure TDiaDlg.PlayerClick(Sender: TObject);
357begin
358 ShowNewContent_Ship(FWindowMode, TComponent(Sender).Tag);
359end;
360
361procedure TDiaDlg.FormKeyDown(Sender: TObject; var Key: Word;
362 Shift: TShiftState);
363begin
364 if (Key = VK_F6) and (Kind = dkChart) then // my key
365 ToggleBtnClick(nil)
366 else if (Key = VK_F8) and (Kind = dkShip) then // my other key
367 else
368 inherited;
369end;
370
371end.
Note: See TracBrowser for help on using the repository browser.