Changeset 518

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.

Location:

trunk

Files:

• LocalPlayer/Select.pas (modified) (1 diff)
• Packages/CevoComponents/ScreenTools.pas (modified) (2 diffs)
• Packages/DpiControls/Dpi.Common.pas (modified) (2 diffs)

trunk/LocalPlayer/Select.pas

@@ -1675 +1675 @@
 
   Kind := ListKind;
-  ModalIndication := not(Kind in MustChooseKind);
+  ModalIndication := not (Kind in MustChooseKind);
   case Kind of
     kProject:

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -892 +892 @@
 begin
   {$IFDEF WINDOWS}
-  // LCLIntf.BitBlt is slower than direct Windows BitBlt
-  Result := Windows.BitBlt(DestCanvas.Handle, ScaleToNative(X), ScaleToNative(Y),
-    ScaleToNative(Width), ScaleToNative(Height), SrcCanvas.Handle,
-    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+    {$IFDEF DPI}
+    Result := BitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
+    {$ELSE}
+    // LCLIntf.BitBlt is slower than direct Windows BitBlt
+    Result := Windows.BitBlt(DestCanvas.Handle, ScaleToNative(X), ScaleToNative(Y),
+      ScaleToNative(Width), ScaleToNative(Height), SrcCanvas.Handle,
+      ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+    {$ENDIF}
   {$ELSE}
   Result := BitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
@@ -1788 +1792 @@
     {$IFDEF DPI}
     if CustomDpiEnabled then Screen.Dpi := CustomDpi
-      else Screen.Dpi := 96; //Screen.GetSystemDpi;
+      else Screen.Dpi := Screen.GetSystemDpi;
     {$ENDIF}
   finally

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;