source: tags/1.3.1/LocalPlayer/NatStat.pas

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