From 6de4d858403da8c9ae26f54fae454d7658fc294b Mon Sep 17 00:00:00 2001
From: skalogryz <skalogryz@8e941d3f-bd1b-0410-a28a-d453659cc2b4>
Date: Tue, 14 Apr 2020 02:38:56 +0000
Subject: [PATCH] richmemo: Win32 special code for WS.PrintTo(). WM_PRINT
 doesn't work as expected for RICHEDIT

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7381 8e941d3f-bd1b-0410-a28a-d453659cc2b4
---
 components/richmemo/win32/win32richmemo.pas | 65 +++++++++++++++++++++
 1 file changed, 65 insertions(+)

diff --git a/components/richmemo/win32/win32richmemo.pas b/components/richmemo/win32/win32richmemo.pas
index 634cb8d6d..a095cba85 100644
--- a/components/richmemo/win32/win32richmemo.pas
+++ b/components/richmemo/win32/win32richmemo.pas
@@ -141,6 +141,8 @@ type
     class function GetCanRedo(const AWinControl: TWinControl): Boolean; override;
 
     class procedure ScrollBy(const AWinControl: TWinControl;  DeltaX, DeltaY: integer); override;
+
+    class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
   end;
 
   { TWin32Inline }
@@ -1547,6 +1549,69 @@ begin
   RichEditManager.SetScroll(AWinControl.Handle, pt);
 end;
 
+class procedure TWin32WSCustomRichMemo.PaintTo(const AWinControl: TWinControl;
+  ADC: HDC; X, Y: Integer);
+var
+  fmt          : TFormatRange;
+  cxPhysOffset : Integer;
+  cyPhysOffset : Integer;
+  cxPhys       : Integer;
+  cyPhys       : Integer;
+  xx, yy: integer;
+  r : TRect;
+begin
+  if not AWinControl.HandleAllocated then Exit;
+
+  // why would WinAPI make things easier if it can make them harder?!
+  // WM_PRINT doesn't seem to be fully functinoal for RICHEDIT
+  // EM_FORMATRANGE needs to be used
+  TWin32WSWinControl.PaintTo(AWinControl, ADC, X,Y);
+  fmt.hdc:=ADC;
+  fmt.hdcTarget:=ADC;
+
+  fmt.chrg.cpMin:=CharAtPos(AWinControl,1,1);
+  fmt.chrg.cpMax:=TCustomRichMemo(AWinControl).GetTextLen;
+
+  case GetDeviceCaps(adc, TECHNOLOGY) of
+    DT_RASDISPLAY, DT_DISPFILE: begin
+      Windows.GetClientRect(AWinControl.Handle, r);
+      r:=Bounds(0,0,AWinControl.Width,AWinControl.Height);
+      //todo: to be properly read from the border settings
+      InflateRect(r, -4, -4);
+      fmt.rcPage.left   := MulDiv(r.Left,  1440, GetDeviceCaps(adc, LOGPIXELSX));
+      fmt.rcPage.top    := MulDiv(r.Top,   1440, GetDeviceCaps(adc, LOGPIXELSY));
+      fmt.rcPage.right  := MulDiv(r.Right, 1440, GetDeviceCaps(adc, LOGPIXELSX));
+      fmt.rcPage.bottom := MulDiv(r.Bottom,1440, GetDeviceCaps(adc, LOGPIXELSY));
+      fmt.rc:=Bounds(
+        MulDiv(X+2,1440, GetDeviceCaps(adc, LOGPIXELSY)),
+        MulDiv(Y+2,1440, GetDeviceCaps(adc, LOGPIXELSY)),
+        fmt.rcPage.Right-fmt.rcPage.Left, fmt.rcPage.Bottom-fmt.rcPage.top);;
+    end;
+    DT_RASPRINTER,DT_PLOTTER,DT_METAFILE: begin
+      cxPhysOffset := GetDeviceCaps(adc, PHYSICALOFFSETX);
+      cyPhysOffset := GetDeviceCaps(adc, PHYSICALOFFSETY);
+      cxPhys := GetDeviceCaps(adc, PHYSICALWIDTH);
+      cyPhys := GetDeviceCaps(adc, PHYSICALHEIGHT);
+
+      // Set page rect to physical page size in twips.
+      fmt.rcPage.top    := 0;
+      fmt.rcPage.left   := 0;
+      fmt.rcPage.right  := MulDiv(cxPhys, 1440, GetDeviceCaps(adc, LOGPIXELSX));
+      fmt.rcPage.bottom := MulDiv(cyPhys, 1440, GetDeviceCaps(adc, LOGPIXELSY));
+
+      // Set the rendering rectangle to the pintable area of the page.
+      fmt.rc.left   := cxPhysOffset;
+      fmt.rc.right  := cxPhysOffset + cxPhys;
+      fmt.rc.top    := cyPhysOffset;
+      fmt.rc.bottom := cyPhysOffset + cyPhys;
+    end;
+  end;
+  SendMessage(AWinControl.Handle, EM_FORMATRANGE, 1, LPARAM(@fmt));
+
+  // free mem. See MSDN
+  SendMessage(AWinControl.Handle, EM_FORMATRANGE, 0, 0);
+end;
+
 // The function doesn't use Windows 7 (Vista?) animations. And should.
 function ThemedNCPaint(AWindow: Windows.HANDLE; RichMemo: TCustomRichMemo; WParam: WParam; LParam: LParam; var Handled: Boolean): LResult;
 begin