Changeset 523 for trunk

Timestamp:

Jan 7, 2024, 11:23:36 PM (11 months ago)

Author:

chronos

Message:

• Fixed: Avoid repeatedly calling Term form resize and repaint in case of fractional scaling.

Location:

trunk

Files:

• LocalPlayer/Term.pas (modified) (6 diffs)
• Packages/DpiControls/Dpi.Common.pas (modified) (2 diffs)
• Packages/DpiControls/Dpi.Controls.pas (modified) (2 diffs)

trunk/LocalPlayer/Term.pas

@@ -4789 +4789 @@
           else if xw > xwd then
             ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, ywd,
-              (xw - xwd) * 2 + 1, MapHeight div yyt - ywd + yw, ProcessOptions)
+              (xw - xwd) * 2 + 1, MapHeight div yyt - ywd + yw, ProcessOptions);
         end
         else if yw > ywd then begin
@@ -4957 +4957 @@
         ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, -1,
           GameMode <> cMovie
-          { (GameMode<>cMovie) and (MyRO.Government<>gAnarchy) } )
+          { (GameMode <> cMovie) and (MyRO.Government <> gAnarchy) } )
       else
         ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, 21, -1,
           GameMode <> cMovie
-          { (GameMode<>cMovie) and (MyRO.Government<>gAnarchy) } );
+          { (GameMode <> cMovie) and (MyRO.Government <> gAnarchy) } );
     end;
 
@@ -4995 +4995 @@
           xSrcBase := -1;
           case BrushTypes[I] of
-            0 .. 8:
+            0..8:
               begin
                 xSrc := BrushTypes[I];
-                ySrc := 0
+                ySrc := 0;
               end;
-            9 .. 30:
+            9..30:
               begin
                 xSrcBase := 2;
@@ -5010 +5010 @@
               begin
                 xSrc := 7;
-                ySrc := 14
+                ySrc := 14;
               end;
             fRoad:
               begin
                 xSrc := 0;
-                ySrc := 9
+                ySrc := 9;
               end;
             fRR:
               begin
                 xSrc := 0;
-                ySrc := 10
+                ySrc := 10;
               end;
             fCanal:
               begin
                 xSrc := 0;
-                ySrc := 11
+                ySrc := 11;
               end;
             fPoll:
               begin
                 xSrc := 6;
-                ySrc := 12
+                ySrc := 12;
               end;
             fDeadLands, fDeadLands or fCobalt, fDeadLands or fUranium,
@@ -5043 +5043 @@
               begin
                 xSrc := BrushTypes[I] shr 12 - 1;
-                ySrc := 12
+                ySrc := 12;
               end;
             tiFort:
@@ -5050 +5050 @@
                 ySrc := 12;
                 xSrcBase := 7;
-                ySrcBase := 12
+                ySrcBase := 12;
               end;
             fPrefStartPos:
               begin
                 xSrc := 0;
-                ySrc := 1
+                ySrc := 1;
               end;
             fStartPos:
               begin
                 xSrc := 0;
-                ySrc := 2
+                ySrc := 2;
               end;
           end;

trunk/Packages/DpiControls/Dpi.Common.pas

@@ -89 +89 @@
   uFlags: UINT): Boolean;
 begin
-  LCLIntf.SetWindowPos(hWnd, hWndInsertAfter, ScaleToNative(X), ScaleToNative(Y),
+  Result := LCLIntf.SetWindowPos(hWnd, hWndInsertAfter, ScaleToNative(X), ScaleToNative(Y),
     ScaleToNative(cx), ScaleToNative(cy), uFlags);
 end;
@@ -105 +105 @@
 function ScaleFromNative(Value: Integer): Integer;
 begin
-  Result := Round(Value * 96 / ScreenInfo.Dpi);
+  Result := Floor(Value * 96 / ScreenInfo.Dpi);
 end;
 

trunk/Packages/DpiControls/Dpi.Controls.pas

@@ -1028 +1028 @@
 
 procedure TControl.NativeFormResize(Sender: TObject);
-begin
-  BoundsRect := ScaleRectFromNative(GetNativeControl.BoundsRect);
+var
+  R: TRect;
+begin
+  R := ScaleRectFromNative(GetNativeControl.BoundsRect);
+  FLeft := R.Left;
+  FTop := R.Top;
+  FWidth := R.Width;
+  FHeight := R.Height;
   DoFormResize;
 end;
@@ -1070 +1076 @@
 
 procedure TControl.UpdateBounds;
-var
-  R: TRect;
 begin
   GetNativeControl.BoundsRect := ScaleRectToNative(BoundsRect);
-  R := ScaleRectToNative(BoundsRect);
-  //WriteLog(Name + ' ' + IntToStr(R.Left) + ', ' + IntToStr(R.Top) + ', ' + IntToStr(R.Width) + ', ' + IntToStr(R.Height))
 end;