richmemo: print event processing

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

components/richmemo/richmemo.pas

@@ -112,7 +112,7 @@ type
   end;
 
   TPrintParams = record
-    Title     : String;
+    JobTitle  : String;       // print job title to be shown in system printing manager
     Margins   : TRectOffsets; // margins in points
     SelStart  : Integer;
     SelLength : Integer;
@@ -122,6 +122,13 @@ type
     Pages     : Integer;
   end;
 
+  TPrintAction = (paDocStart, paPageStart, paPageEnd, paDocEnd);
+
+  TPrintActionEvent = procedure (Sender: TObject;
+    APrintAction: TPrintAction;
+    PrintCanvas: TCanvas;
+    CurrentPage: Integer; var AbortPrint: Boolean) of object;
+
 type
   TRichMemoObject = class(TObject);
   TCustomRichMemo = class;
@@ -145,9 +152,10 @@ type
 
   TCustomRichMemo = class(TCustomMemo)
   private
-    fHideSelection  : Boolean;
+    fHideSelection      : Boolean;
-    fOnSelectionChange: TNotifyEvent;
+    fOnSelectionChange  : TNotifyEvent;
-    fZoomFactor : Double;
+    fOnPrintAction      : TPrintActionEvent;
+    fZoomFactor         : Double;
   private
     procedure InlineInvalidate(handler: TRichMemoInline);
 
@@ -164,6 +172,11 @@ type
     procedure SetSelText(const SelTextUTF8: string); override;
     function GetZoomFactor: Double; virtual;
     procedure SetZoomFactor(AValue: Double); virtual;
+
+    procedure DoPrintAction(PrintJobEvent: TPrintAction;
+      PrintCanvas: TCanvas;
+      CurrentPage: Integer; var AbortPrint: Boolean);
+
   public
     constructor Create(AOwner: TComponent); override;
     procedure CopyToClipboard; override;
@@ -211,6 +224,7 @@ type
     property HideSelection : Boolean read fHideSelection write SetHideSelection;
     property OnSelectionChange: TNotifyEvent read fOnSelectionChange write fOnSelectionChange;
     property ZoomFactor: Double read GetZoomFactor write SetZoomFactor;
+    property OnPrintAction: TPrintActionEvent read fOnPrintAction write fOnPrintAction;
   end;
   
   { TRichMemo }
@@ -262,6 +276,7 @@ type
     property OnMouseWheelUp;
     property OnSelectionChange;
     property OnStartDrag;
+    property OnPrintAction;
     property OnUTF8KeyPress;
     property ParentBidiMode;
     property ParentColor;
@@ -537,6 +552,16 @@ begin
     TWSCustomRichMemoClass(WidgetSetClass).SetZoomFactor(Self, AValue);
 end;
 
+procedure TCustomRichMemo.DoPrintAction(PrintJobEvent: TPrintAction;
+  PrintCanvas: TCanvas; CurrentPage: Integer; var AbortPrint: Boolean);
+begin
+  if Assigned(OnPrintAction) then
+    try
+      OnPrintAction(Self, PrintJobEvent, PrintCanvas, CurrentPAge, AbortPrint);
+    except
+    end;
+end;
+
 procedure TCustomRichMemo.InlineInvalidate(handler: TRichMemoInline);
 begin
   if not Assigned(handler) then Exit;

components/richmemo/richmemohelpers.pas

@@ -345,7 +345,7 @@ var
   prm : TPrintParams;
 begin
   InitPrintParams(prm);
-  prm.Title:=ACaption;
+  prm.JobTitle:=ACaption;
   Print(prm);
 end;
 

components/richmemo/samples/print/mainform.lfm

@@ -6,7 +6,8 @@ object Form1: TForm1
   Caption = 'Form1'
   ClientHeight = 240
   ClientWidth = 687
-  LCLVersion = '1.2.4.0'
+  OnCreate = FormCreate
+  LCLVersion = '1.3'
   object RichMemo1: TRichMemo
     Left = 8
     Height = 178

components/richmemo/samples/print/mainform.pas

@@ -26,10 +26,14 @@ type
     procedure Button2Click(Sender: TObject);
     procedure Button3Click(Sender: TObject);
     procedure Button4Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
   private
     { private declarations }
   public
     { public declarations }
+    procedure RichMemo1PrintAction(Sender: TObject;
+      APrintAction: TPrintAction; PrintCanvas: TCanvas;
+      CurrentPage: Integer; var AbortPrint: Boolean);
   end;
 
 var
@@ -75,7 +79,7 @@ begin
   InitPrintParams(prm);
   prm.SelStart:=RichMemo1.SelStart;
   prm.SelLength:=RichMemo1.SelLength;
-  prm.Title:='Rich Memo Printing';
+  prm.JobTitle:='Rich Memo Printing';
   PageSetupToMargins(PageSetupDialog1, prm);
 
   RichMemo1.Print(prm);
@@ -91,5 +95,22 @@ begin
   PageSetupDialog1.Execute;
 end;
 
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  RichMemo1.OnPrintAction:=@RichMemo1PrintAction;
+end;
+
+procedure TForm1.RichMemo1PrintAction(Sender: TObject;
+  APrintAction: TPrintAction; PrintCanvas: TCanvas; CurrentPage: Integer;
+  var AbortPrint: Boolean);
+begin
+  if APrintAction=paPageStart then begin
+    PrintCanvas.Brush.Color:=clBlue;
+    PrintCanvas.Brush.Style:=bsSolid;
+    PrintCanvas.Ellipse(100,100,200,200);
+  end;
+  writeln('action: ', APrintAction);
+end;
+
 end.
 

components/richmemo/samples/print/project1.lpi

@@ -9,7 +9,6 @@
       <Title Value="project1"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -43,12 +42,12 @@
       <Unit0>
         <Filename Value="project1.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="project1"/>
       </Unit0>
       <Unit1>
         <Filename Value="mainform.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="mainform"/>
       </Unit1>
@@ -64,12 +63,6 @@
       <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <MsgFileName Value=""/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

components/richmemo/win32/win32richmemo.pas

@@ -978,33 +978,43 @@ begin
   TWin32Inline(wsObj).fSink.OnViewChange(DVASPECT_CONTENT, -1);
 end;
 
+type
+  TPrintRichMemo = class(TCustomRichMemo)
+  end;
+
 class function TWin32WSCustomRichMemo.Print(const AWinControl: TWinControl;
   APrinter: TPrinter;
   const AParams: TPrintParams; DoPrint: Boolean): Integer;
 var
-  Rng: TFormatRange;
+  Rng         : TFormatRange;
-  Ofs, MaxLen, LogX, LogY, OldMap: Integer;
+  Ofs, MaxLen : Integer;
-  SaveRect: TRect;
+  LogX, LogY  : Integer;
-  hnd : THandle;
+  OldMap      : Integer;
-  hdc : Windows.HDC;
+  SaveRect    : TRect;
-  PrCh: Integer;
+  hnd         : THandle;
-  maxch : Integer;
+  hdc         : Windows.HDC;
+  PrCh        : Integer;
+  maxch       : Integer;
 
-  fixedRange : Boolean;
+  fixedRange  : Boolean;
-  eventMask  : LongWord;
+  eventMask   : LongWord;
+  rm          : TPrintRichMemo;
+  doAbort     : Boolean;
 const
   PrintFlag : array [Boolean] of byte = (FORMAT_ESTIMATE, FORMAT_RENDER);
 begin
   Result:=0;
-  if not (Assigned(RichEditManager) and Assigned(AWinControl)) then Exit;
+  if not Assigned(RichEditManager) or not Assigned(AWinControl)
+    or not (AWinControl is TCustomRichMemo) then Exit;
 
   hnd:=(AWinControl.Handle);
   if (hnd=0) or (hnd=INVALID_HANDLE_VALUE) then Exit;
+  rm:=TPrintRichMemo(AWinControl);
 
   FillChar(Rng, SizeOf(Rng), 0);
 
   if DoPrint then begin
-    APrinter.Title:=AParams.Title;
+    APrinter.Title:=AParams.JobTitle;
     APrinter.BeginDoc;
   end;
 
@@ -1055,19 +1065,38 @@ begin
     OldMap := SetMapMode(hdc, MM_TEXT);
     SendMessage(hnd, EM_FORMATRANGE, 0, 0);
     try
-      repeat
+      Result:=1;
-        Rng.rc := SaveRect;
+      doAbort:=false;
-        Rng.chrg.cpMin := Ofs;
+      rm.DoPrintAction(paDocStart, APrinter.Canvas, Result, doAbort);
-        Rng.chrg.cpMax := maxch;
+      if not doAbort then begin
-        PrCh := Ofs;
+        repeat
-        Ofs := SendMessage(hnd, EM_FORMATRANGE, PrintFlag[DoPrint], LPARAM(@Rng));
+          rm.DoPrintAction(paPageStart, APrinter.Canvas, Result, doAbort);
-        inc(Result);
+          if doAbort then break;
-        if (Ofs < MaxLen) and (Ofs <> -1) then begin
+
-           if DoPrint then
+          Rng.rc := SaveRect;
-             APrinter.NewPage;
+          Rng.chrg.cpMin := Ofs;
-        end;
+          Rng.chrg.cpMax := maxch;
+          PrCh := Ofs;
+          Ofs := SendMessage(hnd, EM_FORMATRANGE, PrintFlag[DoPrint], LPARAM(@Rng));
+          if (Ofs < MaxLen) and (Ofs <> -1) then begin
+             if DoPrint then begin
+               rm.DoPrintAction(paPageEnd, APrinter.Canvas, Result, doAbort);
+               inc(Result);
+               if not doAbort then APrinter.NewPage;
+             end else
+               inc(Result);
+          end;
+
+        until (Ofs >= MaxLen) or (Ofs = -1) or (PrCh = Ofs) or doAbort;
+
+        if not doAbort then begin
+          rm.DoPrintAction(paPageEnd, APrinter.Canvas, Result, doAbort);
+          if not doAbort then
+            rm.DoPrintAction(paDocEnd, APrinter.Canvas, Result, doAbort);
+         end;
+        if doAbort then APrinter.Abort;
+      end;
 
-      until (Ofs >= MaxLen) or (Ofs = -1) or (PrCh = Ofs);
     finally
       SendMessage(hnd, EM_FORMATRANGE, 0, 0);
       SetMapMode(hdc, OldMap);
@@ -1081,7 +1110,7 @@ begin
       Windows.SendMessage(hnd, WM_SETREDRAW, WPARAM(not false), 0);
     end;
 
-    if DoPrint then
+    if DoPrint and not APrinter.Aborted and not doAbort then
       APrinter.EndDoc
     else
       ReleaseDC(hnd, Rng.hdc);