Changeset 465 for branches/highdpi/LocalPlayer/NatStat.pas

Timestamp:

Nov 30, 2023, 10:16:14 PM (5 months ago)

Author:

chronos

Message:

• Modified: Updated high dpi branch from trunk.
• Modified: Use generics.collections instead of fgl.
• Modified: Compile with Delphi syntax.

File:

• branches/highdpi/LocalPlayer/NatStat.pas (modified) (25 diffs)

branches/highdpi/LocalPlayer/NatStat.pas

@@ -5 +5 @@
 
 uses
-  UDpiControls, Protocol, ClientTools, Term, ScreenTools, BaseWin,
-
-  LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
-  ButtonB, ButtonC, Menus, EOTButton;
+  UDpiControls, Protocol, ClientTools, ScreenTools, BaseWin, LCLIntf, LCLType, SysUtils,
+  Classes, Graphics, Controls, Forms, ButtonB, ButtonC, Menus, EOTButton;
 
 type
@@ -27 +25 @@
     procedure ToggleBtnClick(Sender: TObject);
     procedure PlayerClick(Sender: TObject);
-    procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
+    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormDestroy(Sender: TObject);
     procedure ScrollUpBtnClick(Sender: TObject);
     procedure ScrollDownBtnClick(Sender: TObject);
     procedure TellAIBtnClick(Sender: TObject);
-
   public
     procedure CheckAge;
-    procedure ShowNewContent(NewMode: integer; p: integer = -1);
+    procedure ShowNewContent(NewMode: TWindowMode; P: Integer = -1);
     procedure EcoChange;
-
   protected
     procedure OffscreenPaint; override;
-
   private
-    pView, AgePrepared, LinesDown: integer;
-    SelfReport, CurrentReport: PEnemyReport;
-    ShowContact, ContactEnabled: boolean;
-    Back, Template: TDpiBitmap;
+    pView: Integer;
+    AgePrepared: Integer;
+    LinesDown: Integer;
+    SelfReport: PEnemyReport;
+    CurrentReport: PEnemyReport;
+    ShowContact: Boolean;
+    ContactEnabled: Boolean;
+    Back: TDpiBitmap;
+    Template: TDpiBitmap;
     ReportText: TStringList;
     procedure GenerateReportText;
   end;
 
-var
-  NatStatDlg: TNatStatDlg;
 
 implementation
@@ -58 +56 @@
 
 uses
-  Messg, Tribes, Directories;
+  Term, Messg, Tribes, Directories;
 
 const
@@ -109 +107 @@
   if MainTexture.Age <> AgePrepared then begin
     AgePrepared := MainTexture.Age;
-    DpiBitCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight,
+    DpiBitBltCanvas(Back.Canvas, 0, 0, ClientWidth, ClientHeight,
       MainTexture.Image.Canvas, (MainTexture.Width - ClientWidth) div 2,
       (MainTexture.Height - ClientHeight) div 2);
@@ -118 +116 @@
 procedure TNatStatDlg.FormShow(Sender: TObject);
 begin
-  if pView = me then
+  if pView = Me then
   begin
     SelfReport.TurnOfCivilReport := MyRO.Turn;
     SelfReport.TurnOfMilReport := MyRO.Turn;
-    move(MyRO.Treaty, SelfReport.Treaty, SizeOf(SelfReport.Treaty));
+    Move(MyRO.Treaty, SelfReport.Treaty, SizeOf(SelfReport.Treaty));
     SelfReport.Government := MyRO.Government;
     SelfReport.Money := MyRO.Money;
-    CurrentReport := pointer(SelfReport);
+    CurrentReport := Pointer(SelfReport);
   end
   else
-    CurrentReport := pointer(MyRO.EnemyReport[pView]);
+    CurrentReport := Pointer(MyRO.EnemyReport[pView]);
   if CurrentReport.TurnOfCivilReport >= 0 then
     GenerateReportText;
-  ShowContact := (pView <> me) and (not supervising or (me <> 0));
-  ContactEnabled := ShowContact and not supervising and
+  ShowContact := (pView <> Me) and (not Supervising or (Me <> 0));
+  ContactEnabled := ShowContact and not Supervising and
     (1 shl pView and MyRO.Alive <> 0);
   ContactBtn.Visible := ContactEnabled and (MyRO.Happened and phGameEnd = 0) and
@@ -150 +148 @@
 end;
 
-procedure TNatStatDlg.ShowNewContent(NewMode, p: integer);
-begin
-  if p < 0 then
+procedure TNatStatDlg.ShowNewContent(NewMode: TWindowMode; P: Integer);
+begin
+  if P < 0 then
     if ClientMode >= scContact then
-      pView := DipMem[me].pContact
+      pView := DipMem[Me].pContact
     else
     begin
@@ -160 +158 @@
       while (pView < nPl) and ((MyRO.Treaty[pView] < trNone) or
         (1 shl pView and MyRO.Alive = 0)) do
-        inc(pView);
+        Inc(pView);
       if pView >= nPl then
-        pView := me;
+        pView := Me;
     end
   else
-    pView := p;
+    pView := P;
   inherited ShowNewContent(NewMode);
 end;
@@ -178 +176 @@
   List: ^TChart;
 
-  function StatText(no: integer): string;
+  function StatText(no: Integer): string;
   var
-    i: integer;
+    I: Integer;
   begin
     if (CurrentReport.TurnOfCivilReport >= 0) and
-      (Server(sGetChart + no shl 4, me, pView, List^) >= rExecuted) then
+      (Server(sGetChart + no shl 4, Me, pView, List^) >= rExecuted) then
     begin
-      i := List[CurrentReport.TurnOfCivilReport];
+      I := List[CurrentReport.TurnOfCivilReport];
       case no of
         stPop:
-          result := Format(Phrases.Lookup('FRSTATPOP'), [i]);
+          Result := Format(Phrases.Lookup('FRSTATPOP'), [I]);
         stTerritory:
-          result := Format(Phrases.Lookup('FRSTATTER'), [i]);
+          Result := Format(Phrases.Lookup('FRSTATTER'), [I]);
         stScience:
-          result := Format(Phrases.Lookup('FRSTATTECH'), [i div nAdv]);
+          Result := Format(Phrases.Lookup('FRSTATTECH'), [I div nAdv]);
         stExplore:
-          result := Format(Phrases.Lookup('FRSTATEXP'),
-            [i * 100 div (G.lx * G.ly)]);
+          Result := Format(Phrases.Lookup('FRSTATEXP'),
+            [I * 100 div (G.lx * G.ly)]);
       end;
-    end
+    end;
   end;
 
 var
-  p1, Treaty: integer;
-  s: string;
-  HasContact, ExtinctPart: boolean;
+  p1, Treaty: Integer;
+  S: string;
+  HasContact, ExtinctPart: Boolean;
 begin
   GetMem(List, 4 * (MyRO.Turn + 2));
@@ -212 +210 @@
     (1 shl pView and MyRO.Alive <> 0) then
   begin
-    s := Format(Phrases.Lookup('FROLDCIVILREP'),
+    S := Format(Phrases.Lookup('FROLDCIVILREP'),
       [TurnToString(CurrentReport.TurnOfCivilReport)]);
-    ReportText.Add('C' + s);
+    ReportText.Add('C' + S);
     ReportText.Add('');
   end;
@@ -227 +225 @@
   ReportText.Add('S' + StatText(stScience));
   ReportText.Add('E' + StatText(stExplore));
-  HasContact := false;
+  HasContact := False;
   for p1 := 0 to nPl - 1 do
-    if (p1 <> me) and (CurrentReport.Treaty[p1] > trNoContact) then
-      HasContact := true;
+    if (p1 <> Me) and (CurrentReport.Treaty[p1] > trNoContact) then
+      HasContact := True;
   if HasContact then
   begin
     ReportText.Add('');
     ReportText.Add(' ' + Phrases.Lookup('FRRELATIONS'));
-    for ExtinctPart := false to true do
+    for ExtinctPart := False to True do
       for Treaty := trAlliance downto trNone do
         for p1 := 0 to nPl - 1 do
-          if (p1 <> me) and (CurrentReport.Treaty[p1] = Treaty) and
+          if (p1 <> Me) and (CurrentReport.Treaty[p1] = Treaty) and
             ((1 shl p1 and MyRO.Alive = 0) = ExtinctPart) then
           begin
-            s := Tribe[p1].TString(Phrases.Lookup('HAVETREATY', Treaty));
+            S := Tribe[p1].TString(Phrases.Lookup('HAVETREATY', Treaty));
             if ExtinctPart then
-              s := '(' + s + ')';
-            ReportText.Add(char(48 + Treaty) + s);
+              S := '(' + S + ')';
+            ReportText.Add(char(48 + Treaty) + S);
           end;
   end;
@@ -254 +252 @@
 procedure TNatStatDlg.OffscreenPaint;
 var
-  i, y: integer;
-  s: string;
-  ps: pchar;
-  Extinct: boolean;
-
+  I, Y: Integer;
+  S: string;
+  ps: PChar;
+  Extinct: Boolean;
 begin
   inherited;
@@ -264 +261 @@
   Extinct := 1 shl pView and MyRO.Alive = 0;
 
-  DpiBitCanvas(offscreen.Canvas, 0, 0, ClientWidth, ClientHeight,
+  DpiBitBltCanvas(Offscreen.Canvas, 0, 0, ClientWidth, ClientHeight,
     Back.Canvas, 0, 0);
 
-  offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
-  RisedTextout(offscreen.Canvas,
+  Offscreen.Canvas.Font.Assign(UniFont[ftCaption]);
+  RisedTextout(Offscreen.Canvas,
     40 { (ClientWidth-BiColorTextWidth(offscreen.canvas,caption)) div 2 } ,
     7, Caption);
 
-  offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
-
-  with offscreen do
+  Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
+
+  with Offscreen do
   begin
     // show leader picture
@@ -280 +277 @@
     if Assigned(Tribe[pView].faceHGr) then
     begin
-      Dump(offscreen, Tribe[pView].faceHGr, 18, yIcon - 4, 64, 48,
+      Dump(Offscreen, Tribe[pView].faceHGr, 18, yIcon - 4, 64, 48,
         1 + Tribe[pView].facepix mod 10 * 65,
         1 + Tribe[pView].facepix div 10 * 49);
-      frame(offscreen.Canvas, 18 - 1, yIcon - 4 - 1, 18 + 64, yIcon - 4 + 48,
+      Frame(Offscreen.Canvas, 18 - 1, yIcon - 4 - 1, 18 + 64, yIcon - 4 + 48,
         $000000, $000000);
     end;
 
-    if (pView = me) or not Extinct then
+    if (pView = Me) or not Extinct then
       LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib,
         Phrases.Lookup('GOVERNMENT', CurrentReport.Government) +
         Phrases.Lookup('FRAND'));
-    if pView = me then
+    if pView = Me then
     begin
       LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19,
@@ -305 +302 @@
           Phrases.Lookup('FREXTINCT'));
         LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 28,
-          TurnToString(CurrentReport.TurnOfCivilReport))
+          TurnToString(CurrentReport.TurnOfCivilReport));
       end
       else
@@ -318 +315 @@
       if MyRO.Treaty[pView] = trNoContact then
       begin
-        s := Phrases.Lookup('FRNOCONTACT');
+        S := Phrases.Lookup('FRNOCONTACT');
         LoweredTextOut(Canvas, -1, MainTexture,
-          (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, yRelation + 9, s)
+          (ClientWidth - BiColorTextWidth(Canvas, S)) div 2, yRelation + 9, S);
       end
       else if ShowContact then
@@ -344 +341 @@
         FrameImage(Canvas, BigImp, xIcon, yIcon, xSizeBig, ySizeBig, 0, 200)
         { else if CurrentReport.Government=gAnarchy then
-          FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,112,400,
+          FrameImage(Canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,112,400,
           ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact))
           else
-          FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,
+          FrameImage(Canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,
           56*(CurrentReport.Government-1),40,
           ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact)) };
@@ -365 +362 @@
       end;
 
-      y := 0;
-      for i := 0 to ReportText.Count - 1 do
-      begin
-        if (i >= LinesDown) and (i < LinesDown + ReportLines) then
+      Y := 0;
+      for I := 0 to ReportText.Count - 1 do
+      begin
+        if (I >= LinesDown) and (I < LinesDown + ReportLines) then
         begin
-          s := ReportText[i];
-          if s <> '' then
+          S := ReportText[I];
+          if S <> '' then
           begin
             // LineType:=s[1];
-            delete(s, 1, 1);
+            Delete(S, 1, 1);
             BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkMisc, cliPaperText],
-              $7F007F, xReport + 8, yReport + LineSpacing * y, s);
+              $7F007F, xReport + 8, yReport + LineSpacing * Y, S);
           end;
-          inc(y);
-        end
+          Inc(Y);
+        end;
       end;
     end
     else
     begin
-      s := Phrases.Lookup('FRNOCIVILREP');
-      RisedTextout(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) div 2,
-        yReport + hReport div 2 - 10, s);
+      S := Phrases.Lookup('FRNOCIVILREP');
+      RisedTextout(Canvas, (ClientWidth - BiColorTextWidth(Canvas, S)) div 2,
+        yReport + hReport div 2 - 10, S);
     end;
 
     if soTellAI in OptionChecked then begin
-      Server(sGetAIInfo, me, pView, ps);
+      Server(sGetAIInfo, Me, pView, ps);
       LoweredTextOut(Canvas, -1, MainTexture, 42, 445, ps);
     end else
@@ -396 +393 @@
         Phrases2.Lookup('MENU_TELLAI'));
   end;
-  ContactBtn.SetBack(offscreen.Canvas, ContactBtn.Left, ContactBtn.Top);
+
+  ContactBtn.SetBack(Offscreen.Canvas, ContactBtn.Left, ContactBtn.Top);
 
   MarkUsedOffscreen(ClientWidth, ClientHeight);
-end; { OffscreenPaint }
+end;
 
 procedure TNatStatDlg.CloseBtnClick(Sender: TObject);
 begin
-  Close
+  Close;
 end;
 
 procedure TNatStatDlg.DialogBtnClick(Sender: TObject);
 var
-  ContactResult: integer;
+  ContactResult: Integer;
 begin
   ContactResult := MainScreen.DipCall(scContact + pView shl 4);
@@ -416 +414 @@
       SoundMessage(Phrases.Lookup('FRCOLDWAR'), 'MSG_DEFAULT')
     else if MyRO.Government = gAnarchy then
-      SoundMessage(Tribe[me].TPhrase('FRMYANARCHY'), 'MSG_DEFAULT')
+      SoundMessage(Tribe[Me].TPhrase('FRMYANARCHY'), 'MSG_DEFAULT')
     else if ContactResult = eAnarchy then
       if MyRO.Treaty[pView] >= trPeace then
       begin
         if MainScreen.ContactRefused(pView, 'FRANARCHY') then
-          SmartUpdateContent
+          SmartUpdateContent;
       end
       else
@@ -427 +425 @@
   end
   else
-    Close
+    Close;
 end;
 
 procedure TNatStatDlg.ToggleBtnClick(Sender: TObject);
 var
-  p1, StartCount: integer;
-  m: TDpiMenuItem;
-  ExtinctPart: boolean;
+  p1, StartCount: Integer;
+  M: TDpiMenuItem;
+  ExtinctPart: Boolean;
 begin
   EmptyMenu(Popup.Items);
 
   // own nation
-  if G.Difficulty[me] <> 0 then
-  begin
-    m := TDpiMenuItem.Create(Popup);
-    m.RadioItem := true;
-    m.Caption := Tribe[me].TPhrase('TITLE_NATION');
-    m.Tag := me;
-    m.OnClick := PlayerClick;
-    if me = pView then
-      m.Checked := true;
-    Popup.Items.Add(m);
+  if G.Difficulty[Me] <> 0 then
+  begin
+    M := TDpiMenuItem.Create(Popup);
+    M.RadioItem := True;
+    M.Caption := Tribe[Me].TPhrase('TITLE_NATION');
+    M.Tag := Me;
+    M.OnClick := PlayerClick;
+    if Me = pView then
+      M.Checked := True;
+    Popup.Items.Add(M);
   end;
 
   // foreign nations
-  for ExtinctPart := false to true do
+  for ExtinctPart := False to True do
   begin
     StartCount := Popup.Items.Count;
@@ -460 +458 @@
         (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] >= trNone) then
       begin
-        m := TDpiMenuItem.Create(Popup);
-        m.RadioItem := true;
-        m.Caption := Tribe[p1].TPhrase('TITLE_NATION');
+        M := TDpiMenuItem.Create(Popup);
+        M.RadioItem := True;
+        M.Caption := Tribe[p1].TPhrase('TITLE_NATION');
         if ExtinctPart then
-          m.Caption := '(' + m.Caption + ')';
-        m.Tag := p1;
-        m.OnClick := PlayerClick;
+          M.Caption := '(' + M.Caption + ')';
+        M.Tag := p1;
+        M.OnClick := PlayerClick;
         if p1 = pView then
-          m.Checked := true;
-        Popup.Items.Add(m);
+          M.Checked := True;
+        Popup.Items.Add(M);
       end;
     if (StartCount > 0) and (Popup.Items.Count > StartCount) then
     begin // seperator
-      m := TDpiMenuItem.Create(Popup);
-      m.Caption := '-';
-      Popup.Items.Insert(StartCount, m);
+      M := TDpiMenuItem.Create(Popup);
+      M.Caption := '-';
+      Popup.Items.Insert(StartCount, M);
     end;
   end;
@@ -482 +480 @@
 end;
 
-procedure TNatStatDlg.FormKeyDown(Sender: TObject; var Key: word;
+procedure TNatStatDlg.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
 var
-  i: integer;
+  I: Integer;
 begin
   if Key = VK_F9 then // my key
   begin // toggle nation
-    i := 0;
+    I := 0;
     repeat
       pView := (pView + 1) mod nPl;
-      inc(i);
-    until (i >= nPl) or (1 shl pView and MyRO.Alive <> 0) and
+      Inc(I);
+    until (I >= nPl) or (1 shl pView and MyRO.Alive <> 0) and
       (MyRO.Treaty[pView] >= trNone);
-    if i >= nPl then
-      pView := me;
+    if I >= nPl then
+      pView := Me;
     Tag := pView;
     PlayerClick(self); // no, this is not nice
   end
   else
-    inherited
+    inherited;
 end;
 
 procedure TNatStatDlg.EcoChange;
 begin
-  if Visible and (pView = me) then
+  if Visible and (pView = Me) then
   begin
     SelfReport.Government := MyRO.Government;
     SelfReport.Money := MyRO.Money;
-    SmartUpdateContent
-  end
+    SmartUpdateContent;
+  end;
 end;
 
@@ -518 +516 @@
   if LinesDown > 0 then
   begin
-    dec(LinesDown);
+    Dec(LinesDown);
     SmartUpdateContent;
-  end
+  end;
 end;
 
@@ -527 +525 @@
   if LinesDown + ReportLines < ReportText.Count then
   begin
-    inc(LinesDown);
+    Inc(LinesDown);
     SmartUpdateContent;
-  end
+  end;
 end;
 
@@ -540 +538 @@
   else
     TellAIBtn.ButtonIndex := 2;
-  SmartUpdateContent
+  SmartUpdateContent;
 end;