Changeset 518 for trunk/Packages/DpiControls

Timestamp:

Jan 6, 2024, 12:07:04 AM (11 months ago)

Author:

chronos

Message:

• Fixed: Make fractional scaling work also on Windows.
• Modified: By default use system DPI setting.

File:

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

trunk/Packages/DpiControls/Dpi.Common.pas

@@ -186 +186 @@
   SrcWidth, SrcHeight: Integer;
 begin
-  {$IFDEF WINDOWS}
-  // LCLIntf.BitBlt is slower than direct Windows BitBlt
-  Result := Windows.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
-    ScaleToNative(Width), ScaleToNative(Height), SrcDC,
-    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
-  {$ELSE}
-
   DstWidth := ScaleToNativeDist(X, Width);
   DstHeight := ScaleToNativeDist(Y, Height);
   SrcWidth := ScaleToNativeDist(XSrc, Width);
   SrcHeight := ScaleToNativeDist(YSrc, Height);
+
   if (DstWidth = SrcWidth) and (DstHeight = SrcHeight) then begin
+    {$IFDEF WINDOWS}
+    // On Windows LCLIntf.BitBlt is slower than direct Windows BitBlt
+    Result := Windows.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+      DstWidth, DstHeight, SrcDC,
+      ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+    {$ELSE}
     Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
       DstWidth, DstHeight, SrcDC,
       ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+    {$ENDIF}
   end else begin
+    {$IFDEF WINDOWS}
+    // On Windows LCLIntf.BitBlt is slower than direct Windows BitBlt
+    Result := Windows.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+      Min(SrcWidth, DstWidth), Min(DstHeight, SrcHeight), SrcDC,
+      ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+
+    // Instead calling StretchBlt for entire region try to draw missing part with BitBlt
+    if DstWidth > SrcWidth then begin
+      Windows.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
+      Windows.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y) + SrcHeight,
+        DstWidth, DstHeight - SrcHeight, SrcDC,
+        ScaleToNative(XSrc), ScaleToNative(YSrc) + SrcHeight - (DstHeight - SrcHeight), Rop);
+    end;
+    {$ELSE}
     Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
-      SrcWidth, SrcHeight, SrcDC,
+      Min(SrcWidth, DstWidth), Min(DstHeight, SrcHeight), SrcDC,
       ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
 
@@ -217 +236 @@
         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);}
+    {$ENDIF}
   end;
-
-{  Result := LCLIntf.BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
-    ScaleToNative(Width), ScaleToNative(Height), SrcDC,
-    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
- }
-  {$ENDIF}
 end;