source: tags/1.3.2/LocalPlayer/NatStat.pas

Last change on this file was 536, checked in by chronos, 15 months ago
  • 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
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;
260begin
261 inherited;
262
263 Extinct := 1 shl pView and MyRO.Alive = 0;
264
265 BitBltBitmap(Offscreen, 0, 0, ClientWidth, ClientHeight, Back, 0, 0);
266
267 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
268 RisedTextOut(Offscreen.Canvas,
269 40 { (ClientWidth - BiColorTextWidth(Offscreen.Canvas,Caption)) div 2 },
270 7, Caption);
271
272 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
273
274 with Offscreen do
275 begin
276 // show leader picture
277 Tribe[pView].InitAge(GetAge(pView));
278 if Assigned(Tribe[pView].faceHGr) then
279 begin
280 Dump(Offscreen, Tribe[pView].faceHGr, 18, yIcon - 4, 64, 48,
281 1 + Tribe[pView].facepix mod 10 * 65,
282 1 + Tribe[pView].facepix div 10 * 49);
283 Frame(Offscreen.Canvas, 18 - 1, yIcon - 4 - 1, 18 + 64, yIcon - 4 + 48,
284 $000000, $000000);
285 end;
286
287 if (pView = Me) or not Extinct then
288 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib,
289 Phrases.Lookup('GOVERNMENT', CurrentReport.Government) +
290 Phrases.Lookup('FRAND'));
291 if pView = Me then
292 begin
293 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19,
294 Phrases.Lookup('CREDIBILITY', RoughCredibility(MyRO.Credibility)));
295 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 38,
296 Format(Phrases.Lookup('FRCREDIBILITY'), [MyRO.Credibility]));
297 end
298 else
299 begin
300 if Extinct then
301 begin
302 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 9,
303 Phrases.Lookup('FREXTINCT'));
304 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 28,
305 TurnToString(CurrentReport.TurnOfCivilReport));
306 end
307 else
308 begin
309 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19,
310 Phrases.Lookup('CREDIBILITY',
311 RoughCredibility(CurrentReport.Credibility)));
312 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 38,
313 Format(Phrases.Lookup('FRCREDIBILITY'), [CurrentReport.Credibility]));
314 end;
315
316 if MyRO.Treaty[pView] = trNoContact then
317 begin
318 S := Phrases.Lookup('FRNOCONTACT');
319 LoweredTextOut(Canvas, -1, MainTexture,
320 (ClientWidth - BiColorTextWidth(Canvas, S)) div 2, yRelation + 9, S);
321 end
322 else if ShowContact then
323 begin
324 LoweredTextOut(Canvas, -1, MainTexture, xRelation, yRelation,
325 Phrases.Lookup('FRTREATY'));
326 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2, yRelation,
327 Phrases.Lookup('TREATY', MyRO.Treaty[pView]));
328 if CurrentReport.TurnOfContact < 0 then
329 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2,
330 yRelation + 19, Phrases.Lookup('FRNOVISIT'))
331 else
332 begin
333 LoweredTextOut(Canvas, -1, MainTexture, xRelation, yRelation + 19,
334 Phrases.Lookup('FRLASTCONTACT'));
335 if CurrentReport.TurnOfContact >= 0 then
336 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2,
337 yRelation + 19, TurnToString(CurrentReport.TurnOfContact));
338 end;
339 end;
340
341 if Extinct then
342 FrameImage(Canvas, BigImp, xIcon, yIcon, xSizeBig, ySizeBig, 0, 200)
343 { else if CurrentReport.Government=gAnarchy then
344 FrameImage(Canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,112,400,
345 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact))
346 else
347 FrameImage(Canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,
348 56*(CurrentReport.Government-1),40,
349 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact)) };
350 end;
351
352 if CurrentReport.TurnOfCivilReport >= 0 then
353 begin // print state report
354 FillSeamless(Canvas, xReport, yReport, wReport, hReport, 0, 0, Paper);
355 with Canvas do
356 begin
357 Brush.Color := MainTexture.ColorBevelShade;
358 FillRect(Rect(xReport + wReport, yReport + PaperShade,
359 xReport + wReport + PaperShade, yReport + hReport + PaperShade));
360 FillRect(Rect(xReport + PaperShade, yReport + hReport,
361 xReport + wReport + PaperShade, yReport + hReport + PaperShade));
362 Brush.Style := TBrushStyle.bsClear;
363 end;
364
365 Y := 0;
366 for I := 0 to ReportText.Count - 1 do
367 begin
368 if (I >= LinesDown) and (I < LinesDown + ReportLines) then
369 begin
370 S := ReportText[I];
371 if S <> '' then
372 begin
373 // LineType:=s[1];
374 Delete(S, 1, 1);
375 BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkMisc, cliPaperText],
376 $7F007F, xReport + 8, yReport + LineSpacing * Y, S);
377 end;
378 Inc(Y);
379 end;
380 end;
381 end
382 else
383 begin
384 S := Phrases.Lookup('FRNOCIVILREP');
385 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, S)) div 2,
386 yReport + hReport div 2 - 10, S);
387 end;
388
389 if soTellAI in OptionChecked then begin
390 Server(sGetAIInfo, Me, pView, ps);
391 LoweredTextOut(Canvas, -1, MainTexture, 42, 445, ps);
392 end else
393 LoweredTextOut(Canvas, -2, MainTexture, 42, 445,
394 Phrases2.Lookup('MENU_TELLAI'));
395 end;
396
397 ContactBtn.SetBack(Offscreen.Canvas, ContactBtn.Left, ContactBtn.Top);
398
399 MarkUsedOffscreen(ClientWidth, ClientHeight);
400end;
401
402procedure TNatStatDlg.CloseBtnClick(Sender: TObject);
403begin
404 Close;
405end;
406
407procedure TNatStatDlg.DialogBtnClick(Sender: TObject);
408var
409 ContactResult: Integer;
410begin
411 ContactResult := MainScreen.DipCall(scContact + pView shl 4);
412 if ContactResult < rExecuted then
413 begin
414 if ContactResult = eColdWar then
415 SoundMessage(Phrases.Lookup('FRCOLDWAR'), 'MSG_DEFAULT')
416 else if MyRO.Government = gAnarchy then
417 SoundMessage(Tribe[Me].TPhrase('FRMYANARCHY'), 'MSG_DEFAULT')
418 else if ContactResult = eAnarchy then
419 if MyRO.Treaty[pView] >= trPeace then
420 begin
421 if MainScreen.ContactRefused(pView, 'FRANARCHY') then
422 SmartUpdateContent;
423 end
424 else
425 SoundMessage(Tribe[pView].TPhrase('FRANARCHY'), 'MSG_DEFAULT');
426 end
427 else
428 Close;
429end;
430
431procedure TNatStatDlg.ToggleBtnClick(Sender: TObject);
432var
433 p1, StartCount: Integer;
434 M: TMenuItem;
435 ExtinctPart: Boolean;
436begin
437 EmptyMenu(Popup.Items);
438
439 // own nation
440 if G.Difficulty[Me] <> 0 then
441 begin
442 M := TMenuItem.Create(Popup);
443 M.RadioItem := True;
444 M.Caption := Tribe[Me].TPhrase('TITLE_NATION');
445 M.Tag := Me;
446 M.OnClick := PlayerClick;
447 if Me = pView then
448 M.Checked := True;
449 Popup.Items.Add(M);
450 end;
451
452 // foreign nations
453 for ExtinctPart := False to True do
454 begin
455 StartCount := Popup.Items.Count;
456 for p1 := 0 to nPl - 1 do
457 if ExtinctPart and (G.Difficulty[p1] > 0) and
458 (1 shl p1 and MyRO.Alive = 0) or not ExtinctPart and
459 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] >= trNone) then
460 begin
461 M := TMenuItem.Create(Popup);
462 M.RadioItem := True;
463 M.Caption := Tribe[p1].TPhrase('TITLE_NATION');
464 if ExtinctPart then
465 M.Caption := '(' + M.Caption + ')';
466 M.Tag := p1;
467 M.OnClick := PlayerClick;
468 if p1 = pView then
469 M.Checked := True;
470 Popup.Items.Add(M);
471 end;
472 if (StartCount > 0) and (Popup.Items.Count > StartCount) then
473 begin // seperator
474 M := TMenuItem.Create(Popup);
475 M.Caption := '-';
476 Popup.Items.Insert(StartCount, M);
477 end;
478 end;
479
480 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height);
481end;
482
483procedure TNatStatDlg.FormKeyDown(Sender: TObject; var Key: Word;
484 Shift: TShiftState);
485var
486 I: Integer;
487begin
488 if Key = VK_F9 then // my key
489 begin // toggle nation
490 I := 0;
491 repeat
492 pView := (pView + 1) mod nPl;
493 Inc(I);
494 until (I >= nPl) or (1 shl pView and MyRO.Alive <> 0) and
495 (MyRO.Treaty[pView] >= trNone);
496 if I >= nPl then
497 pView := Me;
498 Tag := pView;
499 PlayerClick(Self); // no, this is not nice
500 end
501 else
502 inherited;
503end;
504
505procedure TNatStatDlg.EcoChange;
506begin
507 if Visible and (pView = Me) then
508 begin
509 SelfReport.Government := MyRO.Government;
510 SelfReport.Money := MyRO.Money;
511 SmartUpdateContent;
512 end;
513end;
514
515procedure TNatStatDlg.ScrollUpBtnClick(Sender: TObject);
516begin
517 if LinesDown > 0 then
518 begin
519 Dec(LinesDown);
520 SmartUpdateContent;
521 end;
522end;
523
524procedure TNatStatDlg.ScrollDownBtnClick(Sender: TObject);
525begin
526 if LinesDown + ReportLines < ReportText.Count then
527 begin
528 Inc(LinesDown);
529 SmartUpdateContent;
530 end;
531end;
532
533procedure TNatStatDlg.TellAIBtnClick(Sender: TObject);
534begin
535 if soTellAI in OptionChecked then OptionChecked := OptionChecked - [soTellAI]
536 else OptionChecked := OptionChecked + [soTellAI];
537 if soTellAI in OptionChecked then
538 TellAIBtn.ButtonIndex := 3
539 else
540 TellAIBtn.ButtonIndex := 2;
541 SmartUpdateContent;
542end;
543
544end.
Note: See TracBrowser for help on using the repository browser.