Changeset 514 for trunk/Packages/DpiControls/Dpi.Common.pas

Timestamp:

Jan 3, 2024, 3:05:32 PM (11 months ago)

Author:

chronos

Message:

• Modified: LogoBuffer is in fact general DrawBuffer. Use single DrawBuffer for all units.
• Modified: Improved fractional scaling.

File:

• trunk/Packages/DpiControls/Dpi.Common.pas (modified) (6 diffs)

trunk/Packages/DpiControls/Dpi.Common.pas

@@ -5 +5 @@
 uses
   {$IFDEF WINDOWS}Windows,{$ENDIF}
-  Classes, SysUtils, LCLType, Types, LCLIntf, Graphics, Dpi.Graphics;
+  Classes, SysUtils, LCLType, Types, Math, LCLIntf, Graphics, Dpi.Graphics;
 
 const
@@ -100 +100 @@
 function ScaleToNative(Value: Integer): Integer;
 begin
-  Result := Round(Value * ScreenInfo.Dpi / 96);
+  Result := Ceil(Value * ScreenInfo.Dpi / 96);
 end;
 
@@ -110 +110 @@
 function ScaleFromNative(Value: Integer): Integer;
 begin
-  Result := Round(Value * 96 / ScreenInfo.Dpi);
+  Result := Floor(Value * 96 / ScreenInfo.Dpi);
 end;
 
@@ -185 +185 @@
   DstWidth, DstHeight: Integer;
   SrcWidth, SrcHeight: Integer;
+  ReduceWidth, ReduceHeight: Integer;
 begin
   {$IFDEF WINDOWS}
@@ -193 +194 @@
   {$ELSE}
 
-
   DstWidth := ScaleToNativeDist(X, Width);
   DstHeight := ScaleToNativeDist(Y, Height);
   SrcWidth := ScaleToNativeDist(XSrc, Width);
   SrcHeight := ScaleToNativeDist(YSrc, Height);
+  if (Frac(ScaleFloatToNative(XSrc)) > 0) or
+    (Frac(ScaleFloatToNative(X)) > 0) then ReduceWidth := 1
+    else ReduceWidth := 0;
+  if (Frac(ScaleFloatToNative(YSrc)) > 0) or
+    (Frac(ScaleFloatToNative(Y)) > 0) then ReduceHeight := 1
+    else ReduceHeight := 0;
   if (DstWidth = SrcWidth) and (DstHeight = SrcHeight) then begin
     Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
@@ -204 +210 @@
   end else begin
     Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
-      DstWidth, DstHeight, SrcDC,
+      DstWidth - ReduceWidth, DstHeight - ReduceHeight, SrcDC,
       ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
-{    Result := LCLIntfStretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+
+    // Instead calling StretchBlt for entire region try to draw missing part with BitBlt
+    if DstWidth > SrcWidth then begin
+      LCLIntf.BitBlt(DestDC, ScaleToNative(X) + SrcWidth, ScaleToNative(Y),
+        DstWidth - SrcWidth, DstHeight, SrcDC,
+        ScaleToNative(XSrc) + SrcWidth - (DstWidth - SrcWidth), ScaleToNative(YSrc), Rop);
+    end;
+    if DstHeight > SrcHeight then begin
+      LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y) + SrcHeight,
+        DstWidth, DstHeight - SrcHeight, SrcDC,
+        ScaleToNative(XSrc), ScaleToNative(YSrc) + SrcHeight - (DstHeight - SrcHeight), Rop);
+    end;
+
+  {  Result := LCLIntf.StretchBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
       DstWidth, DstHeight, SrcDC,
       ScaleToNative(XSrc), ScaleToNative(YSrc),
-      SrcWidth, SrcHeight, Rop);
-}  end;
+      SrcWidth, SrcHeight, Rop);}
+  end;
 
 {  Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),