Changeset 247 for branches/highdpi/Packages/DpiControls/UDpiControls.pas

Timestamp:

May 21, 2020, 10:30:59 PM (4 years ago)

Author:

chronos

Message:

• Modified: Enabled scaling under Windows.
• Fixed: Use correct scaled Windows BitBlt.
• Modified: Fixed and optimized help watermark method.

File:

• branches/highdpi/Packages/DpiControls/UDpiControls.pas (modified) (2 diffs)

branches/highdpi/Packages/DpiControls/UDpiControls.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
+  Windows, Classes, SysUtils, LCLProc, LResources, Forms, FormEditingIntf, ProjectIntf,
   Controls, StdCtrls, fgl, Graphics, ComCtrls, ExtCtrls, LCLType, GraphType,
   Types, CustApp, LMessages, LCLIntf, Menus;
@@ -990 +990 @@
   YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
 begin
-  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y), ScaleToNative(Width),
-    ScaleToNative(Height), SrcDC, ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+  {$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}
+  Result := BitBlt(DestDC, ScaleToNative(X), ScaleToNative(Y),
+    ScaleToNative(Width), ScaleToNative(Height), SrcDC,
+    ScaleToNative(XSrc), ScaleToNative(YSrc), Rop);
+  {$ENDIF}
 end;