source: tags/1.3.5/LocalPlayer/NatStat.pas

Last change on this file was 549, checked in by chronos, 19 months ago
  • Modified: Optimize code with earlier break from for cycle evaluating boolean result.
  • Modified: Code cleanup.
File size: 16.3 KB
Line 
1{$INCLUDE Switches.inc}
2unit NatStat;
3
4interface
5
6uses
7 Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils,
8 Classes, ButtonB, ButtonC, EOTButton,
9 {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.Menus{$ELSE}
10 Graphics, Controls, Forms, Menus{$ENDIF};
11
12type
13 PEnemyReport = ^TEnemyReport;
14
15 TNatStatDlg = class(TBufferedDrawDlg)
16 ToggleBtn: TButtonB;
17 CloseBtn: TButtonB;
18 Popup: TPopupMenu;
19 ScrollUpBtn: TButtonC;
20 ScrollDownBtn: TButtonC;
21 ContactBtn: TEOTButton;
22 TellAIBtn: TButtonC;
23 procedure FormCreate(Sender: TObject);
24 procedure FormShow(Sender: TObject);
25 procedure CloseBtnClick(Sender: TObject);
26 procedure DialogBtnClick(Sender: TObject);
27 procedure ToggleBtnClick(Sender: TObject);
28 procedure PlayerClick(Sender: TObject);
29 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
30 procedure FormDestroy(Sender: TObject);
31 procedure ScrollUpBtnClick(Sender: TObject);
32 procedure ScrollDownBtnClick(Sender: TObject);
33 procedure TellAIBtnClick(Sender: TObject);
34 protected
35 procedure OffscreenPaint; override;
36 private
37 pView: Integer;
38 AgePrepared: Integer;
39 LinesDown: Integer;
40 SelfReport: PEnemyReport;
41 CurrentReport: PEnemyReport;
42 ShowContact: Boolean;
43 ContactEnabled: Boolean;
44 Back: TBitmap;
45 Template: TBitmap;
46 ReportText: TStringList;
47 procedure GenerateReportText;
48 public
49 procedure CheckAge;
50 procedure ShowNewContent(NewMode: TWindowMode; P: Integer = -1);
51 procedure EcoChange;
52 end;
53
54
55implementation
56
57{$R *.lfm}
58
59uses
60 Term, Messg, Tribes, Directories;
61
62const
63 xIcon = 326;
64 yIcon = 49;
65 xAttrib = 96;
66 yAttrib = 40;
67 xRelation = 16;
68 yRelation = 110;
69 PaperShade = 3;
70 ReportLines = 12;
71 LineSpacing = 22;
72 xReport = 24;
73 yReport = 165;
74 wReport = 352;
75 hReport = ReportLines * LineSpacing;
76
77procedure TNatStatDlg.FormCreate(Sender: TObject);
78begin
79 inherited;
80 AgePrepared := -2;
81 GetMem(SelfReport, SizeOf(TEnemyReport) - 2 * (INFIN + 1));
82 ReportText := TStringList.Create;
83 InitButtons;
84 ContactBtn.Template := Templates.Data;
85 HelpContext := 'DIPLOMACY';
86 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT');
87 ContactBtn.Hint := Phrases.Lookup('BTN_DIALOG');
88
89 Back := TBitmap.Create;
90 Back.PixelFormat := TPixelFormat.pf24bit;
91 Back.SetSize(Width, Height);
92 Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);
93 Template := TBitmap.Create;
94 Template.PixelFormat := TPixelFormat.pf24bit;
95 LoadGraphicFile(Template, GetGraphicsDir + DirectorySeparator + 'Nation.png',
96 [gfNoGamma]);
97end;
98
99procedure TNatStatDlg.FormDestroy(Sender: TObject);
100begin
101 FreeAndNil(ReportText);
102 FreeMem(SelfReport);
103 FreeAndNil(Template);
104 FreeAndNil(Back);
105end;
106
107procedure TNatStatDlg.CheckAge;
108begin
109 if MainTexture.Age <> AgePrepared then begin
110 AgePrepared := MainTexture.Age;
111 BitBltBitmap(Back, 0, 0, Width, Height,
112 MainTexture.Image, (MainTexture.Width - Width) div 2,
113 (MainTexture.Height - Height) div 2);
114 ImageOp_B(Back, Template, 0, 0, 0, 0, Width, Height);
115 end;
116end;
117
118procedure TNatStatDlg.FormShow(Sender: TObject);
119begin
120 if pView = Me then
121 begin
122 SelfReport.TurnOfCivilReport := MyRO.Turn;
123 SelfReport.TurnOfMilReport := MyRO.Turn;
124 Move(MyRO.Treaty, SelfReport.Treaty, SizeOf(SelfReport.Treaty));
125 SelfReport.Government := MyRO.Government;
126 SelfReport.Money := MyRO.Money;
127 CurrentReport := Pointer(SelfReport);
128 end
129 else
130 CurrentReport := Pointer(MyRO.EnemyReport[pView]);
131 if CurrentReport.TurnOfCivilReport >= 0 then
132 GenerateReportText;
133 ShowContact := (pView <> Me) and (not Supervising or (Me <> 0));
134 ContactEnabled := ShowContact and not Supervising and
135 (1 shl pView and MyRO.Alive <> 0);
136 ContactBtn.Visible := ContactEnabled and (MyRO.Happened and phGameEnd = 0) and
137 (ClientMode < scContact);
138 ScrollUpBtn.Visible := (CurrentReport.TurnOfCivilReport >= 0) and
139 (ReportText.Count > ReportLines);
140 ScrollDownBtn.Visible := (CurrentReport.TurnOfCivilReport >= 0) and
141 (ReportText.Count > ReportLines);
142 if soTellAI in OptionChecked then
143 TellAIBtn.ButtonIndex := 3
144 else
145 TellAIBtn.ButtonIndex := 2;
146 Caption := Tribe[pView].TPhrase('TITLE_NATION');
147 LinesDown := 0;
148
149 OffscreenPaint;
150end;
151
152procedure TNatStatDlg.ShowNewContent(NewMode: TWindowMode; P: Integer);
153begin
154 if P < 0 then
155 if ClientMode >= scContact then
156 pView := DipMem[Me].pContact
157 else
158 begin
159 pView := 0;
160 while (pView < nPl) and ((MyRO.Treaty[pView] < trNone) or
161 (1 shl pView and MyRO.Alive = 0)) do
162 Inc(pView);
163 if pView >= nPl then
164 pView := Me;
165 end
166 else
167 pView := P;
168 inherited ShowNewContent(NewMode);
169end;
170
171procedure TNatStatDlg.PlayerClick(Sender: TObject);
172begin
173 ShowNewContent(FWindowMode, TComponent(Sender).Tag);
174end;
175
176procedure TNatStatDlg.GenerateReportText;
177var
178 List: ^TChart;
179
180 function StatText(no: Integer): string;
181 var
182 I: Integer;
183 begin
184 if (CurrentReport.TurnOfCivilReport >= 0) and
185 (Server(sGetChart + no shl 4, Me, pView, List^) >= rExecuted) then
186 begin
187 I := List[CurrentReport.TurnOfCivilReport];
188 case no of
189 stPop:
190 Result := Format(Phrases.Lookup('FRSTATPOP'), [I]);
191 stTerritory:
192 Result := Format(Phrases.Lookup('FRSTATTER'), [I]);
193 stScience:
194 Result := Format(Phrases.Lookup('FRSTATTECH'), [I div nAdv]);
195 stExplore:
196 Result := Format(Phrases.Lookup('FRSTATEXP'),
197 [I * 100 div (G.lx * G.ly)]);
198 end;
199 end;
200 end;
201
202var
203 p1, Treaty: Integer;
204 S: string;
205 HasContact, ExtinctPart: Boolean;
206begin
207 GetMem(List, 4 * (MyRO.Turn + 2));
208
209 ReportText.Clear;
210 ReportText.Add('');
211 if (MyRO.Turn - CurrentReport.TurnOfCivilReport > 1) and
212 (1 shl pView and MyRO.Alive <> 0) then
213 begin
214 S := Format(Phrases.Lookup('FROLDCIVILREP'),
215 [TurnToString(CurrentReport.TurnOfCivilReport)]);
216 ReportText.Add('C' + S);
217 ReportText.Add('');
218 end;
219
220 if (1 shl pView and MyRO.Alive <> 0) then
221 begin
222 ReportText.Add('M' + Format(Phrases.Lookup('FRTREASURY'),
223 [CurrentReport.Money]));
224 ReportText.Add('P' + StatText(stPop));
225 ReportText.Add('T' + StatText(stTerritory));
226 end;
227 ReportText.Add('S' + StatText(stScience));
228 ReportText.Add('E' + StatText(stExplore));
229 HasContact := False;
230 for p1 := 0 to nPl - 1 do
231 if (p1 <> Me) and (CurrentReport.Treaty[p1] > trNoContact) then begin
232 HasContact := True;
233 Break;
234 end;
235 if HasContact then
236 begin
237 ReportText.Add('');
238 ReportText.Add(' ' + Phrases.Lookup('FRRELATIONS'));
239 for ExtinctPart := False to True do
240 for Treaty := trAlliance downto trNone do
241 for p1 := 0 to nPl - 1 do
242 if (p1 <> Me) and (CurrentReport.Treaty[p1] = Treaty) and
243 ((1 shl p1 and MyRO.Alive = 0) = ExtinctPart) then
244 begin
245 S := Tribe[p1].TString(Phrases.Lookup('HAVETREATY', Treaty));
246 if ExtinctPart then
247 S := '(' + S + ')';
248 ReportText.Add(Char(48 + Treaty) + S);
249 end;
250 end;
251 ReportText.Add('');
252
253 FreeMem(List);
254end;
255
256procedure TNatStatDlg.OffscreenPaint;
257var
258 I, Y: Integer;
259 S: string;
260 ps: PChar;
261 Extinct: Boolean;
262begin
263 inherited;
264
265 Extinct := 1 shl pView and MyRO.Alive = 0;
266
267 BitBltBitmap(Offscreen, 0, 0, ClientWidth, ClientHeight, Back, 0, 0);
268
269 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
270 RisedTextOut(Offscreen.Canvas,
271 40 { (ClientWidth - BiColorTextWidth(Offscreen.Canvas,Caption)) div 2 },
272 7, Caption);
273
274 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
275
276 with Offscreen do
277 begin
278 // show leader picture
279 Tribe[pView].InitAge(GetAge(pView));
280 if Assigned(Tribe[pView].faceHGr) then
281 begin
282 Dump(Offscreen, Tribe[pView].faceHGr, 18, yIcon - 4, 64, 48,
283 1 + Tribe[pView].facepix mod 10 * 65,
284 1 + Tribe[pView].facepix div 10 * 49);
285 Frame(Offscreen.Canvas, 18 - 1, yIcon - 4 - 1, 18 + 64, yIcon - 4 + 48,
286 $000000, $000000);
287 end;
288
289 if (pView = Me) or not Extinct then
290 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib,
291 Phrases.Lookup('GOVERNMENT', CurrentReport.Government) +
292 Phrases.Lookup('FRAND'));
293 if pView = Me then
294 begin
295 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19,
296 Phrases.Lookup('CREDIBILITY', RoughCredibility(MyRO.Credibility)));
297 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 38,
298 Format(Phrases.Lookup('FRCREDIBILITY'), [MyRO.Credibility]));
299 end
300 else
301 begin
302 if Extinct then
303 begin
304 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 9,
305 Phrases.Lookup('FREXTINCT'));
306 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 28,
307 TurnToString(CurrentReport.TurnOfCivilReport));
308 end
309 else
310 begin
311 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19,
312 Phrases.Lookup('CREDIBILITY',
313 RoughCredibility(CurrentReport.Credibility)));
314 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 38,
315 Format(Phrases.Lookup('FRCREDIBILITY'), [CurrentReport.Credibility]));
316 end;
317
318 if MyRO.Treaty[pView] = trNoContact then
319 begin
320 S := Phrases.Lookup('FRNOCONTACT');
321 LoweredTextOut(Canvas, -1, MainTexture,
322 (ClientWidth - BiColorTextWidth(Canvas, S)) div 2, yRelation + 9, S);
323 end
324 else if ShowContact then
325 begin
326 LoweredTextOut(Canvas, -1, MainTexture, xRelation, yRelation,
327 Phrases.Lookup('FRTREATY'));
328 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2, yRelation,
329 Phrases.Lookup('TREATY', MyRO.Treaty[pView]));
330 if CurrentReport.TurnOfContact < 0 then
331 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2,
332 yRelation + 19, Phrases.Lookup('FRNOVISIT'))
333 else
334 begin
335 LoweredTextOut(Canvas, -1, MainTexture, xRelation, yRelation + 19,
336 Phrases.Lookup('FRLASTCONTACT'));
337 if CurrentReport.TurnOfContact >= 0 then
338 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2,
339 yRelation + 19, TurnToString(CurrentReport.TurnOfContact));
340 end;
341 end;
342
343 if Extinct then
344 FrameImage(Canvas, BigImp, xIcon, yIcon, xSizeBig, ySizeBig, 0, 200)
345 { else if CurrentReport.Government=gAnarchy then
346 FrameImage(Canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,112,400,
347 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact))
348 else
349 FrameImage(Canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,
350 56*(CurrentReport.Government-1),40,
351 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact)) };
352 end;
353
354 if CurrentReport.TurnOfCivilReport >= 0 then
355 begin // print state report
356 FillSeamless(Canvas, xReport, yReport, wReport, hReport, 0, 0, Paper);
357 with Canvas do
358 begin
359 Brush.Color := MainTexture.ColorBevelShade;
360 FillRect(Rect(xReport + wReport, yReport + PaperShade,
361 xReport + wReport + PaperShade, yReport + hReport + PaperShade));
362 FillRect(Rect(xReport + PaperShade, yReport + hReport,
363 xReport + wReport + PaperShade, yReport + hReport + PaperShade));
364 Brush.Style := TBrushStyle.bsClear;
365 end;
366
367 Y := 0;
368 for I := 0 to ReportText.Count - 1 do
369 begin
370 if (I >= LinesDown) and (I < LinesDown + ReportLines) then
371 begin
372 S := ReportText[I];
373 if S <> '' then
374 begin
375 // LineType:=s[1];
376 Delete(S, 1, 1);
377 BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkMisc, cliPaperText],
378 $7F007F, xReport + 8, yReport + LineSpacing * Y, S);
379 end;
380 Inc(Y);
381 end;
382 end;
383 end
384 else
385 begin
386 S := Phrases.Lookup('FRNOCIVILREP');
387 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, S)) div 2,
388 yReport + hReport div 2 - 10, S);
389 end;
390
391 if soTellAI in OptionChecked then begin
392 Server(sGetAIInfo, Me, pView, ps);
393 LoweredTextOut(Canvas, -1, MainTexture, 42, 445, ps);
394 end else
395 LoweredTextOut(Canvas, -2, MainTexture, 42, 445,
396 Phrases2.Lookup('MENU_TELLAI'));
397 end;
398
399 ContactBtn.SetBack(Offscreen.Canvas, ContactBtn.Left, ContactBtn.Top);
400
401 MarkUsedOffscreen(ClientWidth, ClientHeight);
402end;
403
404procedure TNatStatDlg.CloseBtnClick(Sender: TObject);
405begin
406 Close;
407end;
408
409procedure TNatStatDlg.DialogBtnClick(Sender: TObject);
410var
411 ContactResult: Integer;
412begin
413 ContactResult := MainScreen.DipCall(scContact + pView shl 4);
414 if ContactResult < rExecuted then
415 begin
416 if ContactResult = eColdWar then
417 SoundMessage(Phrases.Lookup('FRCOLDWAR'), 'MSG_DEFAULT')
418 else if MyRO.Government = gAnarchy then
419 SoundMessage(Tribe[Me].TPhrase('FRMYANARCHY'), 'MSG_DEFAULT')
420 else if ContactResult = eAnarchy then
421 if MyRO.Treaty[pView] >= trPeace then
422 begin
423 if MainScreen.ContactRefused(pView, 'FRANARCHY') then
424 SmartUpdateContent;
425 end
426 else
427 SoundMessage(Tribe[pView].TPhrase('FRANARCHY'), 'MSG_DEFAULT');
428 end
429 else
430 Close;
431end;
432
433procedure TNatStatDlg.ToggleBtnClick(Sender: TObject);
434var
435 p1, StartCount: Integer;
436 M: TMenuItem;
437 ExtinctPart: Boolean;
438begin
439 EmptyMenu(Popup.Items);
440
441 // own nation
442 if G.Difficulty[Me] <> 0 then
443 begin
444 M := TMenuItem.Create(Popup);
445 M.RadioItem := True;
446 M.Caption := Tribe[Me].TPhrase('TITLE_NATION');
447 M.Tag := Me;
448 M.OnClick := PlayerClick;
449 if Me = pView then
450 M.Checked := True;
451 Popup.Items.Add(M);
452 end;
453
454 // foreign nations
455 for ExtinctPart := False to True do
456 begin
457 StartCount := Popup.Items.Count;
458 for p1 := 0 to nPl - 1 do
459 if ExtinctPart and (G.Difficulty[p1] > 0) and
460 (1 shl p1 and MyRO.Alive = 0) or not ExtinctPart and
461 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] >= trNone) then
462 begin
463 M := TMenuItem.Create(Popup);
464 M.RadioItem := True;
465 M.Caption := Tribe[p1].TPhrase('TITLE_NATION');
466 if ExtinctPart then
467 M.Caption := '(' + M.Caption + ')';
468 M.Tag := p1;
469 M.OnClick := PlayerClick;
470 if p1 = pView then
471 M.Checked := True;
472 Popup.Items.Add(M);
473 end;
474 if (StartCount > 0) and (Popup.Items.Count > StartCount) then
475 begin // seperator
476 M := TMenuItem.Create(Popup);
477 M.Caption := '-';
478 Popup.Items.Insert(StartCount, M);
479 end;
480 end;
481
482 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height);
483end;
484
485procedure TNatStatDlg.FormKeyDown(Sender: TObject; var Key: Word;
486 Shift: TShiftState);
487var
488 I: Integer;
489begin
490 if Key = VK_F9 then // my key
491 begin // toggle nation
492 I := 0;
493 repeat
494 pView := (pView + 1) mod nPl;
495 Inc(I);
496 until (I >= nPl) or (1 shl pView and MyRO.Alive <> 0) and
497 (MyRO.Treaty[pView] >= trNone);
498 if I >= nPl then
499 pView := Me;
500 Tag := pView;
501 PlayerClick(Self); // no, this is not nice
502 end
503 else
504 inherited;
505end;
506
507procedure TNatStatDlg.EcoChange;
508begin
509 if Visible and (pView = Me) then
510 begin
511 SelfReport.Government := MyRO.Government;
512 SelfReport.Money := MyRO.Money;
513 SmartUpdateContent;
514 end;
515end;
516
517procedure TNatStatDlg.ScrollUpBtnClick(Sender: TObject);
518begin
519 if LinesDown > 0 then
520 begin
521 Dec(LinesDown);
522 SmartUpdateContent;
523 end;
524end;
525
526procedure TNatStatDlg.ScrollDownBtnClick(Sender: TObject);
527begin
528 if LinesDown + ReportLines < ReportText.Count then
529 begin
530 Inc(LinesDown);
531 SmartUpdateContent;
532 end;
533end;
534
535procedure TNatStatDlg.TellAIBtnClick(Sender: TObject);
536begin
537 if soTellAI in OptionChecked then OptionChecked := OptionChecked - [soTellAI]
538 else OptionChecked := OptionChecked + [soTellAI];
539 if soTellAI in OptionChecked then
540 TellAIBtn.ButtonIndex := 3
541 else
542 TellAIBtn.ButtonIndex := 2;
543 SmartUpdateContent;
544end;
545
546end.
Note: See TracBrowser for help on using the repository browser.