richmemo: Print() method introduced and implemented for Win32.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4056 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/richmemo/richmemo.pas

@@ -25,7 +25,7 @@ interface
 
 uses
   Types, Classes, SysUtils
-  , LCLType, LCLIntf
+  , LCLType, LCLIntf, Printers
   , Graphics, StdCtrls, LazUTF8;
 
 type
@@ -103,6 +103,20 @@ type
     Tabs  : array of TTabStop;
   end;
 
+type
+  TPrintParams = record
+    Title     : String;
+    PageRect  : TRect;   // position of the printed page in points
+                         // points are relative to the physical page (paper) size
+                         // not DPI of the printer
+    SelStart  : Integer;
+    SelLength : Integer;
+  end;
+
+  TPrintMeasure = record
+    Pages     : Integer;
+  end;
+
 type
   TRichMemoObject = class(TObject);
   TCustomRichMemo = class;
@@ -131,6 +145,9 @@ type
     fZoomFactor : Double;
   private
     procedure InlineInvalidate(handler: TRichMemoInline);
+
+    //todo: PrintMeasure doesn't work propertly
+    function PrintMeasure(const params: TPrintParams; var est: TPrintMeasure): Boolean;
   protected
     procedure DoSelectionChange;
     class procedure WSRegisterClass; override;
@@ -184,6 +201,8 @@ type
 
     function Search(const ANiddle: string; Start, Len: Integer; const SearchOpt: TSearchOptions): Integer;
 
+    function Print(const params: TPrintParams): Integer;
+
     property HideSelection : Boolean read fHideSelection write SetHideSelection;
     property OnSelectionChange: TNotifyEvent read fOnSelectionChange write fOnSelectionChange;
     property ZoomFactor: Double read GetZoomFactor write SetZoomFactor;
@@ -270,6 +289,7 @@ procedure InitParaNumber(var n: TParaNumbering; ASepChar: WideChar = SepPar; Sta
 procedure InitParaBullet(var n: TParaNumbering);
 procedure InitTabStopList(var tabs: TTabStopList); overload;
 procedure InitTabStopList(var tabs: TTabStopList; const TabStopsPt: array of double); overload;
+procedure InitPrintParams(var prm: TPrintParams);
 
 
 var
@@ -414,6 +434,11 @@ begin
   end;
 end;
 
+procedure InitPrintParams(var prm: TPrintParams);
+begin
+  FillChar(prm, sizeof(prm), 0);
+end;
+
 { TRichMemoInline }
 
 procedure TRichMemoInline.Draw(Canvas: TCanvas; const ASize: TSize);
@@ -873,5 +898,32 @@ begin
     Result:=-1;
 end;
 
+function TCustomRichMemo.Print(const params: TPrintParams): Integer;
+var
+  printed: Integer;
+begin
+  Result:=0;
+  if not Assigned(Printer) then Exit;
+  if not HandleAllocated then HandleNeeded;
+  if HandleAllocated then
+    Result:=TWSCustomRichMemoClass(WidgetSetClass).Print(Self, Printer, params, true);
+end;
+
+function TCustomRichMemo.PrintMeasure(const params: TPrintParams; var est: TPrintMeasure): Boolean;
+begin
+  if not Assigned(Printer) then begin
+    Result:=False;
+    Exit;
+  end;
+
+  if not HandleAllocated then HandleNeeded;
+
+  if HandleAllocated then begin
+    est.Pages:=TWSCustomRichMemoClass(WidgetSetClass).Print(Self, Printer, params, false);
+  end else
+    Result:=false;
+end;
+
+
 end.
 

components/richmemo/richmemohelpers.pas

@@ -86,6 +86,7 @@ type
     function SelAttributes: TTextAttributes;
     function Paragraph: TParaAttributes;
     function FindText(const SearchStr: String; StartPos, Length: Integer; Options: TSearchTypes): Integer;
+    procedure Print(const ACaption: String); overload;
   end;
 {$ELSE}
   {$WARNING Class Helpers require FPC 2.6.0 or later, RichEdit compatible methods will not be available }
@@ -339,6 +340,15 @@ begin
   else Result:=StartPos+Result-1;
 end;
 
+procedure TRichEditForMemo.Print(const ACaption: String);
+var
+  prm : TPrintParams;
+begin
+  InitPrintParams(prm);
+  prm.Title:=ACaption;
+  Print(prm);
+end;
+
 {$ENDIF}
 
 end.

components/richmemo/win32/win32richmemo.pas

@@ -30,7 +30,7 @@ uses
   Classes, SysUtils, 
   // LCL headers
   LCLType, LCLIntf, LCLProc, WSLCLClasses,
-  Graphics, Controls, StdCtrls, 
+  Graphics, Controls, StdCtrls, Printers,
   // Win32WidgetSet
   Win32WSControls, Win32Int, Win32WSStdCtrls, win32proc,
   // RichMemo headers
@@ -115,6 +115,9 @@ type
       const ASize: TSize; AHandler: TRichMemoInline; var wsObj: TRichMemoInlineWSObject): Boolean; override;
     class procedure InlineInvalidate(const AWinControl: TWinControl;
        AHandler: TRichMemoInline; wsObj: TRichMemoInlineWSObject); override;
+
+    class function Print(const AWinControl: TWinControl; APrinter: TPrinter;
+      const AParams: TPrintParams; DoPrint: Boolean): Integer; override;
   end;
 
   { TWin32Inline }
@@ -131,6 +134,11 @@ type
     destructor Destroy; override;
   end;
 
+var
+  // whenever print range is used - insert an additional line break, so EN_FORMATRANGE
+  // doesn't overprint the selected text (until the end of the line).
+  // No info is found online, about the bug
+  FixPrintSelRange : Boolean = true;
   
 implementation
 
@@ -150,12 +158,17 @@ const
   TAB_OFFSET_BITS = 24;
   TAB_ALIGN_MASK  = 3;
   TWIP_PT         = 20; // Twips in Point. Twips are commonly used measurement unit for RichEdit inteface
+  POINTS_INCH     = 72;
+  TWIP_INCH       = POINTS_INCH * TWIP_PT;
 
   TAB_LEFT      = 0;  // Ordinary tab
   TAB_CENTER    = 1;  // Center tab
   TAB_RIGHT     = 2;  // Right-aligned tab
   TAB_DECIMAL   = 3;  // Decimal tab
   TAB_WORD      = 4;  // Word bar tab (vertical bar)
+
+  FORMAT_RENDER   = 1;
+  FORMAT_ESTIMATE = 0;
   
 procedure LockRedraw(AHandle: HWND);
 begin
@@ -964,6 +977,122 @@ begin
   if not Assigned(TWin32Inline(wsObj).fSink) then Exit;
   TWin32Inline(wsObj).fSink.OnViewChange(DVASPECT_CONTENT, -1);
 end;
+
+class function TWin32WSCustomRichMemo.Print(const AWinControl: TWinControl;
+  APrinter: TPrinter;
+  const AParams: TPrintParams; DoPrint: Boolean): Integer;
+var
+  Rng: TFormatRange;
+  Ofs, MaxLen, LogX, LogY, OldMap: Integer;
+  SaveRect: TRect;
+  hnd : THandle;
+  hdc : Windows.HDC;
+  PrCh: Integer;
+  maxch : Integer;
+
+  fixedRange : Boolean;
+  eventMask  : LongWord;
+const
+  PrintFlag : array [Boolean] of byte = (FORMAT_ESTIMATE, FORMAT_RENDER);
+begin
+  Result:=0;
+  if not (Assigned(RichEditManager) and Assigned(AWinControl)) then Exit;
+
+  hnd:=(AWinControl.Handle);
+  if (hnd=0) or (hnd=INVALID_HANDLE_VALUE) then Exit;
+
+  FillChar(Rng, SizeOf(Rng), 0);
+
+  if DoPrint then begin
+    APrinter.Title:=AParams.Title;
+    APrinter.BeginDoc;
+  end;
+
+  fixedRange:=false;
+  try
+    if DoPrint then begin
+      hdc:=APrinter.Canvas.Handle;
+      Rng.hdc:=hdc;
+      Rng.hdcTarget:=hdc;
+    end else begin
+      Rng.hdc:=GetDC(hnd);
+      Rng.hdcTarget:=rng.hdc;
+    end;
+    LogX:=APrinter.XDPI;
+    LogY:=APrinter.YDPI;
+    if (LogX=0) or (LogY=0) then Exit;
+
+    Rng.rcPage:=Bounds( 0, 0
+      ,round(APrinter.PageWidth  / LogX * TWIP_INCH)
+      ,round(APrinter.PageHeight / LogY * TWIP_INCH)
+    );
+
+    if not IsRectEmpty(AParams.PageRect) then begin
+      Rng.rc.left   := round(AParams.PageRect.Left   * TWIP_PT);
+      Rng.rc.top    := round(AParams.PageRect.Top    * TWIP_PT);
+      Rng.rc.right  := round(AParams.PageRect.Right  * TWIP_PT);
+      Rng.rc.bottom := round(AParams.PageRect.Bottom * TWIP_PT);
+    end else begin
+      //todo: use PhysicalOffset?
+      Rng.rc:=Rng.rcPage;
+    end;
+    if not DoPrint then Rng.rcPage.bottom:=Rng.rc.bottom;
+    SaveRect:=Rng.rc;
+
+    if AParams.SelLength<=0 then begin
+      Ofs:=0;
+      MaxLen:=RichEditManager.GetTextLength(hnd);
+
+    end else begin
+      if AParams.SelStart<0 then Ofs:=0
+      else Ofs:=AParams.SelStart;
+      MaxLen:=AParams.SelLength;
+
+      if FixPrintSelRange  then begin
+        fixedRange:=true;
+        Windows.SendMessage(hnd, WM_SETREDRAW, WPARAM(false), 0);
+        eventmask:=RichEditManager.SetEventMask(hnd, 0);
+        RichEditManager.SetText(hnd,#10,Ofs+MaxLen,0);
+        RichEditManager.SetEventMask(hnd, eventmask);
+      end;
+    end;
+    maxch:=Ofs+MaxLen;
+
+    OldMap := SetMapMode(hdc, MM_TEXT);
+    SendMessage(hnd, EM_FORMATRANGE, 0, 0);
+    try
+      repeat
+        Rng.rc := SaveRect;
+        Rng.chrg.cpMin := Ofs;
+        Rng.chrg.cpMax := maxch;
+        PrCh := Ofs;
+        Ofs := SendMessage(hnd, EM_FORMATRANGE, PrintFlag[DoPrint], LPARAM(@Rng));
+        inc(Result);
+        if (Ofs < MaxLen) and (Ofs <> -1) then begin
+           if DoPrint then
+             APrinter.NewPage;
+        end;
+
+      until (Ofs >= MaxLen) or (Ofs = -1) or (PrCh = Ofs);
+    finally
+      SendMessage(hnd, EM_FORMATRANGE, 0, 0);
+      SetMapMode(hdc, OldMap);
+    end;
+
+  finally
+    if fixedRange then begin
+      eventmask:=RichEditManager.SetEventMask(AWinControl.Handle, 0);
+      RichEditManager.SetText(AWinControl.Handle,'',maxch,1);
+      RichEditManager.SetEventMask(AWinControl.Handle, eventmask);
+      Windows.SendMessage(hnd, WM_SETREDRAW, WPARAM(not false), 0);
+    end;
+
+    if DoPrint then
+      APrinter.EndDoc
+    else
+      ReleaseDC(hnd, Rng.hdc);
+  end;
+end;
  
 end.
 

components/richmemo/wsrichmemo.pas

@@ -26,7 +26,7 @@ interface
 uses
   Types, Classes, SysUtils,
   LCLType,
-  Graphics, Controls, StdCtrls,
+  Graphics, Controls, StdCtrls, Printers,
   WSStdCtrls, RichMemo;
 
 type
@@ -92,6 +92,8 @@ type
       const ASize: TSize; AHandler: TRichMemoInline; var wsObj: TRichMemoInlineWSObject): Boolean; virtual;
     class procedure InlineInvalidate(const AWinControl: TWinControl;
        AHandler: TRichMemoInline; wsObj: TRichMemoInlineWSObject); virtual;
+
+    class function Print(const AWinControl: TWinControl; APrinter: TPrinter; const AParams: TPrintParams; DoPrint: Boolean): Integer; virtual;
   end;
   TWSCustomRichMemoClass = class of TWSCustomRichMemo;
 
@@ -247,5 +249,11 @@ begin
 
 end;
 
+class function TWSCustomRichMemo.Print(const AWinControl: TWinControl;
+  APrinter: TPrinter; const AParams: TPrintParams; DoPrint: Boolean): Integer;
+begin
+  Result:=0;
+end;
+
 end.