pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4056 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2015-03-20 18:58:11 +00:00
parent 155bbd8662
commit 623a2c3fbf
4 changed files with 202 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
components/richmemo/richmemo.pas
View File

@ -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.

10
components/richmemo/richmemohelpers.pas
View File

@ -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.

131
components/richmemo/win32/win32richmemo.pas
View File

@ -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.

10
components/richmemo/wsrichmemo.pas
View File

@ -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.