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

Timestamp:

May 23, 2020, 12:45:14 AM (4 years ago)

Author:

chronos

Message:

• Fixed: Scrolling under HighDPI. ScrollDC needs to be scaled as well.

File:

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

branches/highdpi/Packages/DpiControls/UDpiControls.pas

@@ -902 +902 @@
 function DpiBitBltCanvas(Dest: TDpiCanvas; X, Y, Width, Height: Integer; Src: TDpiCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
 function DpiCreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
+function DpiScrollDC(hDC:HDC; dx:longint; dy:longint; const lprcScroll:RECT; const lprcClip:RECT;hrgnUpdate:HRGN; lprcUpdate: LPRECT): WINBOOL;
 function ScaleToNative(Value: Integer): Integer;
 function ScaleFromNative(Value: Integer): Integer;
@@ -940 +941 @@
   Result := CreateRectRgn(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2),
     ScaleToNative(Y2));
+end;
+
+{$IFDEF LINUX}
+function LinuxScrollDC(Canvas: TDpiCanvas; dx: longint; dy: longint; const lprcScroll:TRect; const lprcClip:TRect; hrgnUpdate:HRGN; lprcUpdate: PRect):Boolean;
+begin
+end;
+{$ENDIF}
+
+function DpiScrollDC(hDC: HDC; dx: longint; dy: longint;
+  const lprcScroll: RECT; const lprcClip: RECT; hrgnUpdate: HRGN;
+  lprcUpdate: LPRECT): WINBOOL;
+begin
+  {$IFDEF WINDOWS}
+  Result := Windows.ScrollDC(hDC, ScaleToNative(dx), ScaleToNative(dy),
+    ScaleRectToNative(lprcScroll), ScaleRectToNative(lprcClip),
+    hrgnUpdate, lprcUpdate);
+  {$ENDIF}
+  {$IFDEF LINUX}
+  // Can't do scrolling of DC under Linux, then fallback into BitBlt.
+  Result := DpiBitCanvas(Canvas, lprcScroll.Left + dx, lprcScroll.Top + dy, lprcScroll.Right - lprcScroll.Left, lprcScroll.Bottom - lprcScroll.Top,
+    Canvas, lprcScroll.Left, lprcScroll.Top);
+  {$ENDIF}
 end;