Changeset 552 for trunk/Packages/DpiControls

Timestamp:

Apr 24, 2024, 10:28:34 AM (7 months ago)

Author:

chronos

Message:

• Modified: Optimized high DPI scaling. Use lookup table for scaled values. Draw only terrain textures with precise scaling.

Location:

trunk/Packages/DpiControls

Files:

• Dpi.Common.pas (modified) (5 diffs)
• Dpi.Graphics.pas (modified) (4 diffs)

trunk/Packages/DpiControls/Dpi.Common.pas

@@ -15 +15 @@
   XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
 function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer; Src: TBitmap;
-  XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
+  XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY; Precise: Boolean = False): Boolean;
 function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
 {$IFDEF WINDOWS}
@@ -56 +56 @@
 
 function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer;
-  Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
+  Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY;
+  Precise: Boolean = False): Boolean;
 var
   SrcPixel: TPixelPointer;
@@ -65 +66 @@
   NewX, NewY: Integer;
 begin
-  if Frac(ScreenInfo.Dpi / 96) = 0 then
-  begin
+  if not Precise or (Frac(ScreenInfo.Dpi / 96) = 0) then begin
     // Use faster non-fractional scaling
     Result := BitBlt(Dest.Canvas.Handle, X, Y, Width, Height, Src.Canvas.Handle,
@@ -238 +238 @@
 function ScaleToNative(Value: Integer): Integer;
 begin
-  // Round function is faster than Ceil and Floor
-  Result := Round(Value * ScreenInfo.ToNative);
+  Result := ScreenInfo.Lookup[Value];
+  // Round and Trunc are fast. Ceil and Floor slow.
+  // Without lookup table we would use:
+  // Result := Ceil(Value * ScreenInfo.ToNative);
 end;
 
@@ -249 +251 @@
 function ScaleFromNative(Value: Integer): Integer;
 begin
-  Result := Floor(Value * ScreenInfo.FromNative);
+  Result := Trunc(Value * ScreenInfo.FromNative);
 end;
 

trunk/Packages/DpiControls/Dpi.Graphics.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Graphics, LCLType, GraphType, Types;
+  Classes, SysUtils, Math, Graphics, LCLType, GraphType, Types;
 
 const
@@ -347 +347 @@
     ToNative: Double;
     FromNative: Double;
+    Lookup: array[-10000..10000] of Integer; // Should be sufficient for 8K screens
     property Dpi: Integer read FDpi write SetDpi;
   end;
@@ -1322 +1323 @@
 
 procedure TScreenInfo.SetDpi(AValue: Integer);
+var
+  I: Integer;
 begin
   if FDpi = AValue then Exit;
@@ -1327 +1330 @@
   ToNative := ScreenInfo.Dpi / 96;
   FromNative := 96 / ScreenInfo.Dpi;
+  for I := -10000 to 10000 do
+    Lookup[I] := Ceil(I * ToNative);
 end;