source: tags/1.3.0/LocalPlayer/NatStat.pas

Last change on this file was 352, checked in by chronos, 3 years ago
  • Modified: TTexture changed from record to class.
  • Modified: Code cleanup.
File size: 16.2 KB
Line 
1{$INCLUDE Switches.inc}
2unit NatStat;
3
4interface
5
6uses
7 Protocol, ClientTools, Term, ScreenTools, BaseWin,
8
9 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
10 ButtonB, ButtonC, Menus, EOTButton;
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
35 public
36 procedure CheckAge;
37 procedure ShowNewContent(NewMode: integer; p: integer = -1);
38 procedure EcoChange;
39
40 protected
41 procedure OffscreenPaint; override;
42
43 private
44 pView, AgePrepared, LinesDown: integer;
45 SelfReport, CurrentReport: PEnemyReport;
46 ShowContact, ContactEnabled: boolean;
47 Back, Template: TBitmap;
48 ReportText: TStringList;
49 procedure GenerateReportText;
50 end;
51
52var
53 NatStatDlg: TNatStatDlg;
54
55implementation
56
57{$R *.lfm}
58
59uses
60 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 := pf24bit;
91 Back.SetSize(Width, Height);
92 Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);
93 Template := TBitmap.Create;
94 Template.PixelFormat := 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 BitBltCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight,
112 MainTexture.Image.Canvas, (MainTexture.Width - ClientWidth) div 2,
113 (MainTexture.Height - ClientHeight) div 2);
114 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight);
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, 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
232 HasContact := true;
233 if HasContact then
234 begin
235 ReportText.Add('');
236 ReportText.Add(' ' + Phrases.Lookup('FRRELATIONS'));
237 for ExtinctPart := false to true do
238 for Treaty := trAlliance downto trNone do
239 for p1 := 0 to nPl - 1 do
240 if (p1 <> me) and (CurrentReport.Treaty[p1] = Treaty) and
241 ((1 shl p1 and MyRO.Alive = 0) = ExtinctPart) then
242 begin
243 s := Tribe[p1].TString(Phrases.Lookup('HAVETREATY', Treaty));
244 if ExtinctPart then
245 s := '(' + s + ')';
246 ReportText.Add(char(48 + Treaty) + s);
247 end;
248 end;
249 ReportText.Add('');
250
251 FreeMem(List);
252end;
253
254procedure TNatStatDlg.OffscreenPaint;
255var
256 i, y: integer;
257 s: string;
258 ps: pchar;
259 Extinct: boolean;
260
261begin
262 inherited;
263
264 Extinct := 1 shl pView and MyRO.Alive = 0;
265
266 BitBltCanvas(offscreen.Canvas, 0, 0, ClientWidth, ClientHeight,
267 Back.Canvas, 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 := 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 ContactBtn.SetBack(offscreen.Canvas, ContactBtn.Left, ContactBtn.Top);
399
400 MarkUsedOffscreen(ClientWidth, ClientHeight);
401end; { OffscreenPaint }
402
403procedure TNatStatDlg.CloseBtnClick(Sender: TObject);
404begin
405 Close
406end;
407
408procedure TNatStatDlg.DialogBtnClick(Sender: TObject);
409var
410 ContactResult: integer;
411begin
412 ContactResult := MainScreen.DipCall(scContact + pView shl 4);
413 if ContactResult < rExecuted then
414 begin
415 if ContactResult = eColdWar then
416 SoundMessage(Phrases.Lookup('FRCOLDWAR'), 'MSG_DEFAULT')
417 else if MyRO.Government = gAnarchy then
418 SoundMessage(Tribe[me].TPhrase('FRMYANARCHY'), 'MSG_DEFAULT')
419 else if ContactResult = eAnarchy then
420 if MyRO.Treaty[pView] >= trPeace then
421 begin
422 if MainScreen.ContactRefused(pView, 'FRANARCHY') then
423 SmartUpdateContent
424 end
425 else
426 SoundMessage(Tribe[pView].TPhrase('FRANARCHY'), 'MSG_DEFAULT');
427 end
428 else
429 Close
430end;
431
432procedure TNatStatDlg.ToggleBtnClick(Sender: TObject);
433var
434 p1, StartCount: integer;
435 m: TMenuItem;
436 ExtinctPart: boolean;
437begin
438 EmptyMenu(Popup.Items);
439
440 // own nation
441 if G.Difficulty[me] <> 0 then
442 begin
443 m := TMenuItem.Create(Popup);
444 m.RadioItem := true;
445 m.Caption := Tribe[me].TPhrase('TITLE_NATION');
446 m.Tag := me;
447 m.OnClick := PlayerClick;
448 if me = pView then
449 m.Checked := true;
450 Popup.Items.Add(m);
451 end;
452
453 // foreign nations
454 for ExtinctPart := false to true do
455 begin
456 StartCount := Popup.Items.Count;
457 for p1 := 0 to nPl - 1 do
458 if ExtinctPart and (G.Difficulty[p1] > 0) and
459 (1 shl p1 and MyRO.Alive = 0) or not ExtinctPart and
460 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] >= trNone) then
461 begin
462 m := TMenuItem.Create(Popup);
463 m.RadioItem := true;
464 m.Caption := Tribe[p1].TPhrase('TITLE_NATION');
465 if ExtinctPart then
466 m.Caption := '(' + m.Caption + ')';
467 m.Tag := p1;
468 m.OnClick := PlayerClick;
469 if p1 = pView then
470 m.Checked := true;
471 Popup.Items.Add(m);
472 end;
473 if (StartCount > 0) and (Popup.Items.Count > StartCount) then
474 begin // seperator
475 m := TMenuItem.Create(Popup);
476 m.Caption := '-';
477 Popup.Items.Insert(StartCount, m);
478 end;
479 end;
480
481 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height);
482end;
483
484procedure TNatStatDlg.FormKeyDown(Sender: TObject; var Key: word;
485 Shift: TShiftState);
486var
487 i: integer;
488begin
489 if Key = VK_F9 then // my key
490 begin // toggle nation
491 i := 0;
492 repeat
493 pView := (pView + 1) mod nPl;
494 inc(i);
495 until (i >= nPl) or (1 shl pView and MyRO.Alive <> 0) and
496 (MyRO.Treaty[pView] >= trNone);
497 if i >= nPl then
498 pView := me;
499 Tag := pView;
500 PlayerClick(self); // no, this is not nice
501 end
502 else
503 inherited
504end;
505
506procedure TNatStatDlg.EcoChange;
507begin
508 if Visible and (pView = me) then
509 begin
510 SelfReport.Government := MyRO.Government;
511 SelfReport.Money := MyRO.Money;
512 SmartUpdateContent
513 end
514end;
515
516procedure TNatStatDlg.ScrollUpBtnClick(Sender: TObject);
517begin
518 if LinesDown > 0 then
519 begin
520 dec(LinesDown);
521 SmartUpdateContent;
522 end
523end;
524
525procedure TNatStatDlg.ScrollDownBtnClick(Sender: TObject);
526begin
527 if LinesDown + ReportLines < ReportText.Count then
528 begin
529 inc(LinesDown);
530 SmartUpdateContent;
531 end
532end;
533
534procedure TNatStatDlg.TellAIBtnClick(Sender: TObject);
535begin
536 if soTellAI in OptionChecked then OptionChecked := OptionChecked - [soTellAI]
537 else OptionChecked := OptionChecked + [soTellAI];
538 if soTellAI in OptionChecked then
539 TellAIBtn.ButtonIndex := 3
540 else
541 TellAIBtn.ButtonIndex := 2;
542 SmartUpdateContent
543end;
544
545end.
Note: See TracBrowser for help on using the repository browser.