source: branches/delphi/LocalPlayer/NatStat.pas

Last change on this file was 6, checked in by chronos, 9 years ago
  • Modified: Formated all project source files using Delphi formatter as original indentation and other formatting was really bad.
File size: 16.1 KB
Line 
1{$INCLUDE switches}
2unit NatStat;
3
4interface
5
6uses
7 Protocol, ClientTools, Term, ScreenTools, BaseWin,
8
9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
10 ButtonBase, 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 *.DFM}
58
59uses
60 Diagram, Select, Messg, MessgEx, Help, 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;
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.Width := ClientWidth;
92 Back.Height := ClientHeight;
93 Template := TBitmap.Create;
94 LoadGraphicFile(Template, HomeDir + 'Graphics\Nation', gfNoGamma);
95 Template.PixelFormat := pf8bit;
96end;
97
98procedure TNatStatDlg.FormDestroy(Sender: TObject);
99begin
100 ReportText.Free;
101 FreeMem(SelfReport);
102 Template.Free;
103 Back.Free;
104end;
105
106procedure TNatStatDlg.CheckAge;
107begin
108 if MainTextureAge <> AgePrepared then
109 begin
110 AgePrepared := MainTextureAge;
111 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
112 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2,
113 (hMainTexture - ClientHeight) div 2, SRCCOPY);
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 OptionChecked and (1 shl soTellAI) <> 0 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 bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
267 Back.Canvas.Handle, 0, 0, SRCCOPY);
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 Tribe[pView].faceHGr >= 0 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.clBevelShade;
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 OptionChecked and (1 shl soTellAI) <> 0 then
392 begin
393 Server(sGetAIInfo, me, pView, ps);
394 LoweredTextOut(Canvas, -1, MainTexture, 42, 445, ps);
395 end
396 else
397 LoweredTextOut(Canvas, -2, MainTexture, 42, 445,
398 Phrases2.Lookup('MENU_TELLAI'));
399 end;
400 ContactBtn.SetBack(offscreen.Canvas, ContactBtn.Left, ContactBtn.Top);
401
402 MarkUsedOffscreen(ClientWidth, ClientHeight);
403end; { OffscreenPaint }
404
405procedure TNatStatDlg.CloseBtnClick(Sender: TObject);
406begin
407 Close
408end;
409
410procedure TNatStatDlg.DialogBtnClick(Sender: TObject);
411var
412 ContactResult: integer;
413begin
414 ContactResult := MainScreen.DipCall(scContact + pView shl 4);
415 if ContactResult < rExecuted then
416 begin
417 if ContactResult = eColdWar then
418 SoundMessage(Phrases.Lookup('FRCOLDWAR'), 'MSG_DEFAULT')
419 else if MyRO.Government = gAnarchy then
420 SoundMessage(Tribe[me].TPhrase('FRMYANARCHY'), 'MSG_DEFAULT')
421 else if ContactResult = eAnarchy then
422 if MyRO.Treaty[pView] >= trPeace then
423 begin
424 if MainScreen.ContactRefused(pView, 'FRANARCHY') then
425 SmartUpdateContent
426 end
427 else
428 SoundMessage(Tribe[pView].TPhrase('FRANARCHY'), 'MSG_DEFAULT');
429 end
430 else
431 Close
432end;
433
434procedure TNatStatDlg.ToggleBtnClick(Sender: TObject);
435var
436 p1, StartCount: integer;
437 m: TMenuItem;
438 ExtinctPart: boolean;
439begin
440 EmptyMenu(Popup.Items);
441
442 // own nation
443 if G.Difficulty[me] <> 0 then
444 begin
445 m := TMenuItem.Create(Popup);
446 m.RadioItem := true;
447 m.Caption := Tribe[me].TPhrase('TITLE_NATION');
448 m.Tag := me;
449 m.OnClick := PlayerClick;
450 if me = pView then
451 m.Checked := true;
452 Popup.Items.Add(m);
453 end;
454
455 // foreign nations
456 for ExtinctPart := false to true do
457 begin
458 StartCount := Popup.Items.Count;
459 for p1 := 0 to nPl - 1 do
460 if ExtinctPart and (G.Difficulty[p1] > 0) and
461 (1 shl p1 and MyRO.Alive = 0) or not ExtinctPart and
462 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] >= trNone) then
463 begin
464 m := TMenuItem.Create(Popup);
465 m.RadioItem := true;
466 m.Caption := Tribe[p1].TPhrase('TITLE_NATION');
467 if ExtinctPart then
468 m.Caption := '(' + m.Caption + ')';
469 m.Tag := p1;
470 m.OnClick := PlayerClick;
471 if p1 = pView then
472 m.Checked := true;
473 Popup.Items.Add(m);
474 end;
475 if (StartCount > 0) and (Popup.Items.Count > StartCount) then
476 begin // seperator
477 m := TMenuItem.Create(Popup);
478 m.Caption := '-';
479 Popup.Items.Insert(StartCount, m);
480 end;
481 end;
482
483 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height);
484end;
485
486procedure TNatStatDlg.FormKeyDown(Sender: TObject; var Key: word;
487 Shift: TShiftState);
488var
489 i: integer;
490begin
491 if Key = VK_F9 then // my key
492 begin // toggle nation
493 i := 0;
494 repeat
495 pView := (pView + 1) mod nPl;
496 inc(i);
497 until (i >= nPl) or (1 shl pView and MyRO.Alive <> 0) and
498 (MyRO.Treaty[pView] >= trNone);
499 if i >= nPl then
500 pView := me;
501 Tag := pView;
502 PlayerClick(self); // no, this is not nice
503 end
504 else
505 inherited
506end;
507
508procedure TNatStatDlg.EcoChange;
509begin
510 if Visible and (pView = me) then
511 begin
512 SelfReport.Government := MyRO.Government;
513 SelfReport.Money := MyRO.Money;
514 SmartUpdateContent
515 end
516end;
517
518procedure TNatStatDlg.ScrollUpBtnClick(Sender: TObject);
519begin
520 if LinesDown > 0 then
521 begin
522 dec(LinesDown);
523 SmartUpdateContent;
524 end
525end;
526
527procedure TNatStatDlg.ScrollDownBtnClick(Sender: TObject);
528begin
529 if LinesDown + ReportLines < ReportText.Count then
530 begin
531 inc(LinesDown);
532 SmartUpdateContent;
533 end
534end;
535
536procedure TNatStatDlg.TellAIBtnClick(Sender: TObject);
537begin
538 OptionChecked := OptionChecked xor (1 shl soTellAI);
539 if OptionChecked and (1 shl soTellAI) <> 0 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.