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

Timestamp:

Nov 30, 2023, 10:16:14 PM (12 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/MessgEx.pas (modified) (27 diffs)

branches/highdpi/LocalPlayer/MessgEx.pas

@@ -5 +5 @@
 
 uses
-  UDpiControls, Messg, Protocol, ScreenTools, Platform, DateUtils,
-  LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA,
-  ButtonB, StdCtrls, DrawDlg;
+  UDpiControls, Messg, Protocol, ScreenTools, Platform, DateUtils, LCLIntf, LCLType, Messages,
+  SysUtils, Classes, Graphics, Controls, Forms, ButtonA, ButtonB, StdCtrls,
+  DrawDlg, Help;
 
 type
@@ -13 +13 @@
     mikPureIcon, mikMyArmy, mikEnemyArmy, mikFullControl, mikShip, mikBigIcon,
     mikEnemyShipComplete);
+
+  { TMessgExDlg }
 
   TMessgExDlg = class(TBaseMessgDlg)
@@ -32 +34 @@
     Kind: TMessageKind;
     IconIndex: Integer;
-    HelpKind: Integer;
+    HelpKind: TLinkCategory;
     HelpNo: Integer;
     CenterTo: Integer;
     IconKind: TMessageIconKind;
     OpenSound: string;
-    function ShowModal: integer; override;
+    function ShowModal: Integer; override;
     procedure CancelMovie;
   private
-    MovieCancelled: boolean;
-    procedure PaintBook(ca: TDpiCanvas; x, y, clPage, clCover: integer);
+    MovieCancelled: Boolean;
+    procedure PaintBook(ca: TDpiCanvas; X, Y, clPage, clCover: Integer);
     procedure PaintMyArmy;
     procedure PaintEnemyArmy;
@@ -47 +49 @@
   end;
 
-var
-  MessgExDlg: TMessgExDlg;
 
 procedure SoundMessageEx(SimpleText, SoundItem: string);
-procedure TribeMessage(p: integer; SimpleText, SoundItem: string);
+procedure TribeMessage(P: Integer; SimpleText, SoundItem: string);
 function SimpleQuery(QueryKind: TMessageKind; SimpleText, SoundItem: string)
-  : integer;
+  : Integer;
 procedure ContextMessage(SimpleText, SoundItem: string;
-  ContextKind, ContextNo: integer);
+  ContextKind: TLinkCategory; ContextNo: Integer);
+
 
 implementation
 
 uses
-  ClientTools, BaseWin, Term, Help, UnitStat, Tribes, UPixelPointer,
-  IsoEngine, Diagram, Sound;
+  ClientTools, BaseWin, Term, UnitStat, Tribes, PixelPointer,
+  Diagram, Sound;
 
 {$R *.lfm}
@@ -78 +79 @@
 procedure TMessgExDlg.FormShow(Sender: TObject);
 var
-  i: integer;
+  I: Integer;
 begin
   if IconKind = mikEnemyArmy then
@@ -147 +148 @@
   end;
 
-  SplitText(true);
+  SplitText(True);
   ClientHeight := 72 + Border + TopSpace + Lines * MessageLineSpacing;
   if GameMode = cMovie then
@@ -178 +179 @@
       end;
   end;
-  for i := 0 to ControlCount - 1 do
-    Controls[i].Top := ClientHeight - (34 + Border);
+  for I := 0 to ControlCount - 1 do
+    Controls[I].Top := ClientHeight - (34 + Border);
   if Kind = mkModel then
     EInput.Top := ClientHeight - (76 + Border);
 end;
 
-function TMessgExDlg.ShowModal: integer;
+function TMessgExDlg.ShowModal: Integer;
 var
   Ticks0: TDateTime;
   Ticks: TDateTime;
 begin
+  Caption := Phrases.Lookup('TITLE_MESSAGE');
   if GameMode = cMovie then
   begin
     if not((GameMode = cMovie) and (MovieSpeed = 4)) then
     begin
-      MovieCancelled := false;
+      MovieCancelled := False;
       Show;
       Ticks0 := NowPrecise;
@@ -203 +205 @@
       Hide;
     end;
-    result := mrOk;
+    Result := mrOk;
   end
   else
-    result := inherited;
+    Result := inherited;
+  //Gtk2Fix;
 end;
 
 procedure TMessgExDlg.CancelMovie;
 begin
-  MovieCancelled := true;
-end;
-
-procedure TMessgExDlg.PaintBook(ca: TDpiCanvas; x, y, clPage, clCover: integer);
+  MovieCancelled := True;
+end;
+
+procedure TMessgExDlg.PaintBook(ca: TDpiCanvas; X, Y, clPage, clCover: Integer);
 const
   xScrewed = 77;
@@ -220 +223 @@
   wScrewed = 43;
   hScrewed = 27;
+type
+  TScrewed = array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of Single;
 var
-  ix, iy, xDst, yDst, dx, dy, xIcon, yIcon: integer;
+  ix, iy, xDst, yDst, dx, dy, xIcon, yIcon: Integer;
   BookRect: TRect;
-  x1, xR, yR, share: single;
-  Screwed: array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of single;
+  x1, xR, yR, share: Single;
+  Screwed: TScrewed;
   SrcPtr: TPixelPointer;
   Width: Integer;
@@ -235 +240 @@
     yIcon := (IconIndex + SystemIconLines * 7) div 7 * ySizeBig;
     // prepare screwed icon
-    FillChar(Screwed, sizeof(Screwed), 0);
+    Screwed := Default(TScrewed);
     BigImp.BeginUpdate;
-    SrcPtr := PixelPointer(BigImp, ScaleToNative(xIcon), ScaleToNative(yIcon));
+    SrcPtr := TPixelPointer.Create(BigImp, ScaleToNative(xIcon), ScaleToNative(yIcon));
     for iy := 0 to ScaleToNative(Height) - 1 do begin
       for ix := 0 to ScaleToNative(Width) - 1 do begin
@@ -277 +282 @@
     BookRect := SmallBook.BoundsRect;
   end;
-  x := x - BookRect.Width div 2;
+  X := X - BookRect.Width div 2;
 
   // paint
   UnshareBitmap(LogoBuffer);
-  DpiBitCanvas(LogoBuffer.Canvas, 0, 0, BookRect.Width, BookRect.Height, ca, x, y);
+  DpiBitBltCanvas(LogoBuffer.Canvas, 0, 0, BookRect.Width, BookRect.Height, ca, X, Y);
 
   if IconIndex >= 0 then
@@ -294 +299 @@
   ImageOp_BCC(LogoBuffer, Templates.Data, Point(0, 0), BookRect, clCover, clPage);
 
-  DpiBitCanvas(ca, x, y, BookRect.Width, BookRect.Height, LogoBuffer.Canvas, 0, 0);
+  DpiBitBltCanvas(ca, X, Y, BookRect.Width, BookRect.Height, LogoBuffer.Canvas, 0, 0);
 end;
 
@@ -303 +308 @@
 procedure TMessgExDlg.PaintEnemyArmy;
 var
-  emix, ix, iy, x, y, count, UnitsInLine: integer;
+  emix, ix, iy, X, Y, count, UnitsInLine: Integer;
 begin
   ix := 0;
@@ -314 +319 @@
     for count := 0 to LostArmy[emix] - 1 do
     begin
-      x := ClientWidth div 2 + ix * 64 - UnitsInLine * 32;
-      y := 26 + Border + TopSpace + Lines * MessageLineSpacing + iy * 48;
+      X := ClientWidth div 2 + ix * 64 - UnitsInLine * 32;
+      Y := 26 + Border + TopSpace + Lines * MessageLineSpacing + iy * 48;
       with MyRO.EnemyModel[emix], Tribe[Owner].ModelPicture[mix] do
       begin
-        DpiBitCanvas(Canvas, x, y, 64, 48, HGr.Mask.Canvas,
+        DpiBitBltCanvas(Canvas, X, Y, 64, 48, HGr.Mask.Canvas,
           pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCAND);
-        DpiBitCanvas(Canvas, x, y, 64, 48, HGr.Data.Canvas,
+        DpiBitBltCanvas(Canvas, X, Y, 64, 48, HGr.Data.Canvas,
           pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCPAINT);
       end;
 
       // next position
-      inc(ix);
+      Inc(ix);
       if ix = LostUnitsPerLine then
       begin // next line
         ix := 0;
-        inc(iy);
+        Inc(iy);
         if iy = 6 then
-          exit;
+          Exit;
         UnitsInLine := nLostArmy - LostUnitsPerLine * iy;
         if UnitsInLine > LostUnitsPerLine then
@@ -341 +346 @@
 procedure TMessgExDlg.FormPaint(Sender: TObject);
 var
-  p1, clSaveTextLight, clSaveTextShade: integer;
+  p1, clSaveTextLight, clSaveTextShade: Integer;
 begin
   if (IconKind = mikImp) and (IconIndex = 27) then
@@ -362 +367 @@
         p1 := MyRO.Wonder[IconIndex].EffectiveOwner;
         UnshareBitmap(Buffer);
-        DpiBitCanvas(Buffer.Canvas, 0, 0, xSizeBig + 2 * GlowRange,
+        DpiBitBltCanvas(Buffer.Canvas, 0, 0, xSizeBig + 2 * GlowRange,
           ySizeBig + 2 * GlowRange, Canvas,
           ClientWidth div 2 - (28 + GlowRange), 24 - GlowRange);
-        DpiBitCanvas(Buffer.Canvas, GlowRange, GlowRange, xSizeBig, ySizeBig,
+        DpiBitBltCanvas(Buffer.Canvas, GlowRange, GlowRange, xSizeBig, ySizeBig,
           BigImp.Canvas, IconIndex mod 7 * xSizeBig,
           (IconIndex + SystemIconLines * 7) div 7 * ySizeBig);
@@ -373 +378 @@
           GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig,
             Tribe[p1].Color);
-        DpiBitCanvas(Canvas, ClientWidth div 2 - (28 + GlowRange),
+        DpiBitBltCanvas(Canvas, ClientWidth div 2 - (28 + GlowRange),
           24 - GlowRange, xSizeBig + 2 * GlowRange, ySizeBig + 2 * GlowRange,
           Buffer.Canvas, 0, 0);
@@ -387 +392 @@
       end;
     mikModel:
-      with Tribe[me].ModelPicture[IconIndex] do
+      with Tribe[Me].ModelPicture[IconIndex] do
       begin
         FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig,
           ySizeBig, 0, 0);
-        DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44,
+        DpiBitBltCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44,
           HGr.Mask.Canvas, pix mod 10 * 65 + 1,
           pix div 10 * 49 + 1, SRCAND);
-        DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44,
+        DpiBitBltCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44,
           HGr.Data.Canvas, pix mod 10 * 65 + 1,
           pix div 10 * 49 + 1, SRCPAINT);
@@ -406 +411 @@
         Frame(Canvas, ClientWidth div 2 - 32 - 1, 24 - 1,
           ClientWidth div 2 + 32, 24 + 48, $000000, $000000);
-        DpiBitCanvas(Canvas, ClientWidth div 2 - 32, 24, 64, 48,
+        DpiBitBltCanvas(Canvas, ClientWidth div 2 - 32, 24, 64, 48,
           Tribe[IconIndex].faceHGr.Data.Canvas,
           1 + Tribe[IconIndex].facepix mod 10 * 65,
@@ -420 +425 @@
     mikEnemyShipComplete:
       begin
-        DpiBitCanvas(Buffer.Canvas, 0, 0, 140, 120, Canvas,
+        DpiBitBltCanvas(Buffer.Canvas, 0, 0, 140, 120, Canvas,
           (ClientWidth - 140) div 2, 24);
         ImageOp_BCC(Buffer, Templates.Data, Point(0, 0), StarshipDeparted.BoundsRect, 0, $FFFFFF);
-        DpiBitCanvas(Canvas, (ClientWidth - 140) div 2, 24, 140, 120,
+        DpiBitBltCanvas(Canvas, (ClientWidth - 140) div 2, 24, 140, 120,
           Buffer.Canvas, 0, 0);
       end;
@@ -451 +456 @@
 begin
   if Kind = mkOkHelp then
-    HelpDlg.ShowNewContent(wmSubmodal, HelpKind, HelpNo)
+    MainScreen.HelpDlg.ShowNewContent(wmSubmodal, HelpKind, HelpNo)
   else if Kind = mkModel then
-    UnitStatDlg.ShowNewContent_OwnModel(wmSubmodal, IconIndex)
+    MainScreen.UnitStatDlg.ShowNewContent_OwnModel(wmSubmodal, IconIndex)
   else
     ModalResult := mrIgnore;
@@ -482 +487 @@
 // because Messg.SoundMessage not capable of movie mode
 begin
-  with MessgExDlg do
+  with MainScreen.MessgExDlg do
   begin
     MessgText := SimpleText;
@@ -491 +496 @@
 end;
 
-procedure TribeMessage(p: integer; SimpleText, SoundItem: string);
-begin
-  with MessgExDlg do
+procedure TribeMessage(P: Integer; SimpleText, SoundItem: string);
+begin
+  with MainScreen.MessgExDlg do
   begin
     OpenSound := SoundItem;
@@ -499 +504 @@
     Kind := mkOk;
     IconKind := mikTribe;
-    IconIndex := p;
+    IconIndex := P;
     ShowModal;
   end;
@@ -505 +510 @@
 
 function SimpleQuery(QueryKind: TMessageKind; SimpleText, SoundItem: string)
-  : integer;
-begin
-  with MessgExDlg do
+  : Integer;
+begin
+  with MainScreen.MessgExDlg do
   begin
     MessgText := SimpleText;
@@ -513 +518 @@
     Kind := QueryKind;
     ShowModal;
-    result := ModalResult;
+    Result := ModalResult;
   end;
 end;
 
 procedure ContextMessage(SimpleText, SoundItem: string;
-  ContextKind, ContextNo: integer);
-begin
-  with MessgExDlg do
+  ContextKind: TLinkCategory; ContextNo: Integer);
+begin
+  with MainScreen.MessgExDlg do
   begin
     MessgText := SimpleText;
@@ -543 +548 @@
 end;
 
-
-initialization
-
 end.