source: tags/1.3.8/LocalPlayer/Diagram.pas

Last change on this file was 684, checked in by chronos, 13 days ago
  • Modified: Improved forms painting if resized to bigger dimensions.
File size: 11.6 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 }
15
16 TDiaDlg = class(TFramedDlg)
17 CloseBtn: TButtonB;
18 ToggleBtn: TButtonB;
19 Popup: TPopupMenu;
20 procedure CloseBtnClick(Sender: TObject);
21 procedure FormPaint(Sender: TObject);
22 procedure FormShow(Sender: TObject);
23 procedure FormCreate(Sender: TObject);
24 procedure ToggleBtnClick(Sender: TObject);
25 procedure PlayerClick(Sender: TObject);
26 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
27 private
28 Kind: TDiagramKind;
29 Player: Integer;
30 Mode: Integer;
31 protected
32 procedure DoOnResize; override;
33 public
34 procedure OffscreenPaint; override;
35 procedure ShowNewContent_Charts(NewMode: TWindowMode);
36 procedure ShowNewContent_Ship(NewMode: TWindowMode; P: Integer = -1);
37 end;
38
39procedure PaintColonyShip(Canvas: TCanvas; Player, Left, Width, Top: Integer);
40
41
42implementation
43
44uses
45 Protocol, ScreenTools, ClientTools, Tribes;
46
47{$R *.lfm}
48
49const
50 Border = 24;
51 RoundPixels: array [0 .. nStat - 1] of Integer = (0, 0, 0, 5, 5, 5);
52
53 yArea = 48;
54 xComp: array [0 .. 5] of Integer = (-60, -28, 4, 4, 36, 68);
55 yComp: array [0 .. 5] of Integer = (-40, -40, -79, -1, -40, -40);
56 xPow: array [0 .. 3] of Integer = (-116, -116, -116, -116);
57 yPow: array [0 .. 3] of Integer = (-28, 0, -44, 16);
58 xHab: array [0 .. 1] of Integer = (23, 23);
59 yHab: array [0 .. 1] of Integer = (-81, 1);
60
61procedure PaintColonyShip(Canvas: TCanvas; Player, Left, Width, Top: Integer);
62var
63 I, X, R, nComp, nPow, nHab: Integer;
64begin
65 Canvas.Brush.Color := $000000;
66 Canvas.FillRect(Rect(Left, Top, Left + Width, Top + 200));
67 Canvas.Brush.Style := TBrushStyle.bsClear;
68 ScreenTools.Frame(Canvas, Left - 1, Top - 1, Left + Width, Top + 200,
69 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
70 RFrame(Canvas, Left - 2, Top - 2, Left + Width + 1, Top + 200 + 1,
71 MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
72
73 // stars
74 DelphiRandSeed := Player * 11111;
75 for I := 1 to Width - 16 do
76 begin
77 X := DelphiRandom((Width - 16) * 200);
78 R := DelphiRandom(13) + 28;
79 Canvas.Pixels[X div 200 + 8, X mod 200 + Top] :=
80 (R * R * R * R div 10001) * $10101;
81 end;
82
83 nComp := MyRO.Ship[Player].Parts[spComp];
84 nPow := MyRO.Ship[Player].Parts[spPow];
85 nHab := MyRO.Ship[Player].Parts[spHab];
86 if nComp > 6 then
87 nComp := 6;
88 if nPow > 4 then
89 nPow := 4;
90 if nHab > 2 then
91 nHab := 2;
92 for I := 0 to nHab - 1 do
93 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xHab[I],
94 Top + 100 + yHab[I], 80, 80, 34, 1);
95 for I := 0 to nComp - 1 do
96 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[I],
97 Top + 100 + yComp[I], 32, 80, 1, 1);
98 if nComp > 0 then
99 for I := 3 downto nPow do
100 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xPow[I] + 40,
101 Top + 100 + yPow[I], 16, 27, 1, 82);
102 for I := nPow - 1 downto 0 do
103 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xPow[I],
104 Top + 100 + yPow[I], 56, 28, 58, 82);
105 if (nComp < 3) and (nHab >= 1) then
106 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32 - 16,
107 Top + 100 + 7 + yComp[2], 16, 27, 1, 82);
108 if (nComp >= 3) and (nHab < 1) then
109 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32,
110 Top + 100 + 7 + yComp[2], 16, 27, 18, 82);
111 if (nComp < 4) and (nHab >= 2) then
112 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32 - 16,
113 Top + 100 + 46 + yComp[3], 16, 27, 1, 82);
114 if (nComp >= 4) and (nHab < 2) then
115 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32,
116 Top + 100 + 46 + yComp[3], 16, 27, 18, 82);
117 if (nComp <> 6) and (nComp <> 2) and not ((nComp = 0) and (nPow < 1)) then
118 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
119 Top + 100 + 7 + yComp[nComp], 16, 27, 18, 82);
120 if (nComp <> 6) and (nComp <> 3) and not ((nComp = 0) and (nPow < 2)) then
121 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
122 Top + 100 + 46 + yComp[nComp], 16, 27, 18, 82);
123 if nComp = 2 then
124 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3],
125 Top + 100 + 7 + yComp[3], 16, 27, 18, 82);
126 if nComp = 3 then
127 Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[4],
128 Top + 100 + 7 + yComp[4], 16, 27, 18, 82);
129end;
130
131procedure TDiaDlg.FormCreate(Sender: TObject);
132begin
133 inherited;
134 TitleHeight := WideFrame + 20;
135 InnerHeight := Height - TitleHeight - NarrowFrame;
136 CaptionRight := CloseBtn.Left;
137 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width;
138 InitButtons;
139end;
140
141procedure TDiaDlg.CloseBtnClick(Sender: TObject);
142begin
143 Close;
144end;
145
146procedure TDiaDlg.OffscreenPaint;
147var
148 P, T, Max, X, Y, y0, Stop, R, RoundRange, LineStep: Integer;
149 S: string;
150 List: ^TChart;
151
152 function Round(T: Integer): Integer;
153 var
154 N, I: Integer;
155 begin
156 if T < RoundRange then
157 N := T
158 else
159 N := RoundRange;
160 Result := 0;
161 for I := T - N to T do
162 Inc(Result, List[I]);
163 Result := Result div (N + 1);
164 end;
165
166 procedure ShareBar(X, Y: Integer; Cap: string; val0, val1: Integer);
167 begin
168 LoweredTextOut(Offscreen.Canvas, -1, MainTexture, X - 2, Y, Cap);
169 DLine(Offscreen.Canvas, X - 2, X + 169, Y + 16, MainTexture.ColorTextShade,
170 MainTexture.ColorTextLight);
171 if val0 > 0 then
172 S := Format(Phrases.Lookup('SHARE'), [val0, val1])
173 else
174 S := '0';
175 RisedTextOut(Offscreen.Canvas,
176 X + 170 - BiColorTextWidth(Offscreen.Canvas, S), Y, S);
177 end;
178
179begin
180 inherited;
181 if Kind = dkChart then
182 with Offscreen.Canvas do
183 begin
184 Font.Assign(UniFont[ftTiny]);
185 Font.Color := $808080;
186
187 RoundRange := RoundPixels[Mode] * (MyRO.Turn - 1)
188 div (InnerWidth - 2 * Border);
189
190 GetMem(List, 4 * (MyRO.Turn + 2));
191 if Mode = stExplore then
192 Max := G.lx * G.ly
193 else
194 begin
195 Max := -1;
196 for P := 0 to nPl - 1 do
197 if (G.Difficulty[P] > 0) and
198 (Server(sGetChart + Mode shl 4, Me, P, List^) >= rExecuted) then
199 for T := 0 to MyRO.Turn - 1 do
200 begin
201 R := Round(T);
202 if R > Max then
203 Max := R;
204 end;
205 end;
206
207 Brush.Color := $000000;
208 FillRect(Rect(0, 0, InnerWidth, InnerHeight));
209 Brush.Style := TBrushStyle.bsClear;
210 Pen.Color := $606060;
211 MoveTo(Border, InnerHeight - Border);
212 LineTo(InnerWidth - Border, InnerHeight - Border);
213 if MyRO.Turn >= 800 then
214 LineStep := 200
215 else if MyRO.Turn >= 400 then
216 LineStep := 100
217 else
218 LineStep := 50;
219 for T := 0 to (MyRO.Turn - 1) div LineStep do
220 begin
221 X := Border + (InnerWidth - 2 * Border) * T *
222 LineStep div (MyRO.Turn - 1);
223 MoveTo(X, Border);
224 LineTo(X, InnerHeight - Border);
225 S := IntToStr(Abs(TurnToYear(T * LineStep)));
226 TextOut(X - TextWidth(S) div 2, Border - 16, S);
227 end;
228
229 y0 := 0;
230 if Max > 0 then
231 begin
232 for P := 0 to nPl - 1 do
233 if (G.Difficulty[P] > 0) and
234 (Server(sGetChart + Mode shl 4, Me, P, List^) >= rExecuted) then
235 begin
236 Pen.Color := Tribe[P].Color;
237 Stop := MyRO.Turn - 1;
238 while (Stop > 0) and (List[Stop] = 0) do
239 Dec(Stop);
240 for T := 0 to Stop do
241 begin
242 R := Round(T);
243 X := Border + (InnerWidth - 2 * Border) * T div (MyRO.Turn - 1);
244 Y := InnerHeight - Border - (InnerHeight - 2 * Border) *
245 R div Max;
246 if T = 0 then
247 MoveTo(X, Y)
248 // else if Mode=stTerritory then
249 // begin LineTo(x,y0); LineTo(x,y) end
250 else if RoundPixels[Mode] = 0 then
251 begin
252 if (Y <> y0) or (T = Stop) then
253 LineTo(X, Y)
254 end
255 else
256 LineTo(X, Y);
257 y0 := Y;
258 end;
259 end;
260 end;
261 FreeMem(List);
262 end
263 else
264 with Offscreen.Canvas do
265 begin
266 Font.Assign(UniFont[ftSmall]);
267 FillOffscreen(0, 0, InnerWidth, InnerHeight);
268
269 PaintColonyShip(Offscreen.Canvas, Player, 8, InnerWidth - 16, yArea);
270
271 ShareBar(InnerWidth div 2 - 85, InnerHeight - 62,
272 Phrases.Lookup('SHIPHAB'), MyRO.Ship[Player].Parts[spHab], 2);
273 ShareBar(InnerWidth div 2 - 85, InnerHeight - 43,
274 Phrases.Lookup('SHIPPOW'), MyRO.Ship[Player].Parts[spPow], 4);
275 ShareBar(InnerWidth div 2 - 85, InnerHeight - 24,
276 Phrases.Lookup('SHIPCOMP'), MyRO.Ship[Player].Parts[spComp], 6);
277 end;
278 MarkUsedOffscreen(InnerWidth, InnerHeight);
279end;
280
281procedure TDiaDlg.FormPaint(Sender: TObject);
282var
283 S: string;
284begin
285 inherited;
286 Canvas.Font.Assign(UniFont[ftNormal]);
287 if Kind = dkChart then
288 S := Phrases.Lookup('DIAGRAM', Mode)
289 else
290 S := Tribe[Player].TPhrase('SHORTNAME');
291 LoweredTextOut(Canvas, -1, MainTexture,
292 (ClientWidth - BiColorTextWidth(Canvas, S)) div 2, 31, S);
293end;
294
295procedure TDiaDlg.FormShow(Sender: TObject);
296begin
297 if WindowMode = wmModal then CenterToScreen;
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
375procedure TDiaDlg.DoOnResize;
376begin
377 inherited;
378 CloseBtn.Left := Width - 38;
379end;
380
381end.
Note: See TracBrowser for help on using the repository browser.