1076 lines
32 KiB
ObjectPascal
1076 lines
32 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvPrvwRender.pas, released on 2003-01-01.
|
|
|
|
The Initial Developer of the Original Code is Peter Thrnqvist.
|
|
Portions created by Peter Thrnqvist are Copyright (c) 2003 by Peter Thrnqvist.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.sourceforge.net
|
|
|
|
Known Issues:
|
|
* setting Stretch to false for graphic items, renders them at the wrong scale
|
|
* the TStrings previewer has a *very* simple word-wrap feature - use the RTF variant if possible
|
|
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvPrvwRender.pas 10612 2006-05-19 19:04:09Z jfudickar $
|
|
|
|
unit JvPrvwRender;
|
|
|
|
{$I jvcl.inc}
|
|
{$I windowsonly.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, SysUtils, Messages, Classes, Controls, Graphics,
|
|
Dialogs, ComCtrls, RichEdit, Printers,
|
|
JvComponentBase, JvPrvwDoc, JvRichEdit;
|
|
|
|
type
|
|
EPrintPreviewError = Exception;
|
|
TJvCustomPreviewRenderer = class(TJvComponent)
|
|
private
|
|
FPrintPreview: TJvCustomPreviewControl;
|
|
FOldAddPage: TJvDrawPageEvent;
|
|
procedure SetPrintPreview(const Value: TJvCustomPreviewControl);
|
|
procedure InternalDoAddPage(Sender: TObject; PageIndex: Integer;
|
|
Canvas: TCanvas; PageRect, PrintRect: TRect; var NeedMorePages: Boolean);
|
|
protected
|
|
procedure DoAddPage(Sender: TObject; PageIndex: Integer;
|
|
Canvas: TCanvas; PageRect, PrintRect: TRect; var NeedMorePages: Boolean); virtual; abstract;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation);
|
|
override;
|
|
property PrintPreview: TJvCustomPreviewControl read FPrintPreview write SetPrintPreview;
|
|
public
|
|
function CreatePreview(Append: Boolean): Boolean; virtual;
|
|
end;
|
|
|
|
TJvPreviewRenderRichEdit = class(TJvCustomPreviewRenderer)
|
|
private
|
|
FFinished: Boolean;
|
|
FLastChar: Integer;
|
|
FRichEdit: TCustomRichEdit;
|
|
procedure SetRichEdit(const Value: TCustomRichEdit);
|
|
protected
|
|
procedure DoAddPage(Sender: TObject; PageIndex: Integer;
|
|
Canvas: TCanvas; PageRect, PrintRect: TRect; var NeedMorePages: Boolean); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation);
|
|
override;
|
|
public
|
|
function CreatePreview(Append: Boolean): Boolean; override;
|
|
published
|
|
property PrintPreview;
|
|
property RichEdit: TCustomRichEdit read FRichEdit write SetRichEdit;
|
|
end;
|
|
|
|
TJvPreviewRenderJvRichEdit = class(TJvCustomPreviewRenderer)
|
|
private
|
|
FFinished: Boolean;
|
|
FLastChar: Integer;
|
|
FRichEdit: TJvCustomRichEdit;
|
|
procedure SetRichEdit(const Value: TJvCustomRichEdit);
|
|
protected
|
|
procedure DoAddPage(Sender: TObject; PageIndex: Integer;
|
|
Canvas: TCanvas; PageRect, PrintRect: TRect; var NeedMorePages: Boolean); override;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
function CreatePreview(Append: Boolean): Boolean; override;
|
|
published
|
|
property PrintPreview;
|
|
property RichEdit: TJvCustomRichEdit read FRichEdit write SetRichEdit;
|
|
end;
|
|
|
|
TJvPreviewRenderStrings = class(TJvCustomPreviewRenderer)
|
|
private
|
|
FFinished: Boolean;
|
|
FCurrentRow: Integer;
|
|
FStrings: TStringList;
|
|
FFont: TFont;
|
|
function GetStrings: TStrings;
|
|
procedure SetStrings(const Value: TStrings);
|
|
procedure SetFont(const Value: TFont);
|
|
protected
|
|
procedure DoAddPage(Sender: TObject; PageIndex: Integer;
|
|
Canvas: TCanvas; PageRect, PrintRect: TRect; var NeedMorePages: Boolean); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function CreatePreview(Append: Boolean): Boolean; override;
|
|
published
|
|
property PrintPreview;
|
|
property Strings: TStrings read GetStrings write SetStrings;
|
|
property Font: TFont read FFont write SetFont;
|
|
end;
|
|
|
|
TJvPreviewGraphicItem = class(TCollectionItem)
|
|
private
|
|
FPicture: TPicture;
|
|
FTransparent: Boolean;
|
|
FCenter: Boolean;
|
|
FStretch: Boolean;
|
|
FProportional: Boolean;
|
|
procedure SetPicture(const Value: TPicture);
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
function DestRect(RefRect: TRect; DestDC: HDC): TRect;
|
|
procedure UpdateGraphic;
|
|
published
|
|
property Picture: TPicture read FPicture write SetPicture;
|
|
property Center: Boolean read FCenter write FCenter default True;
|
|
property Proportional: Boolean read FProportional write FProportional default True;
|
|
property Stretch: Boolean read FStretch write FStretch default True;
|
|
property Transparent: Boolean read FTransparent write FTransparent default False;
|
|
end;
|
|
|
|
TJvPreviewGraphicItems = class(TOwnedCollection)
|
|
private
|
|
function GetItems(Index: Integer): TJvPreviewGraphicItem;
|
|
procedure SetItems(Index: Integer; const Value: TJvPreviewGraphicItem);
|
|
public
|
|
constructor Create(AOwner: TPersistent);
|
|
function Add: TJvPreviewGraphicItem;
|
|
property Items[Index: Integer]: TJvPreviewGraphicItem read GetItems write SetItems; default;
|
|
end;
|
|
|
|
TJvPreviewRenderGraphics = class(TJvCustomPreviewRenderer)
|
|
private
|
|
FImages: TJvPreviewGraphicItems;
|
|
procedure SetImages(const Value: TJvPreviewGraphicItems);
|
|
protected
|
|
function GetPPX(ADC: HDC): Integer;
|
|
function GetPPY(ADC: HDC): Integer;
|
|
procedure DoAddPage(Sender: TObject; PageIndex: Integer; Canvas: TCanvas;
|
|
PageRect, PrintRect: TRect; var NeedMorePages: Boolean); override;
|
|
public
|
|
function CreatePreview(Append: Boolean): Boolean; override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property PrintPreview;
|
|
property Images: TJvPreviewGraphicItems read FImages write SetImages;
|
|
end;
|
|
|
|
// preview a TControl descendant
|
|
TJvPreviewRenderControl = class(TJvCustomPreviewRenderer)
|
|
private
|
|
FControl: TControl;
|
|
FProportional: Boolean;
|
|
FCenter: Boolean;
|
|
FStretch: Boolean;
|
|
procedure SetControl(const Value: TControl);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation);
|
|
override;
|
|
procedure DoAddPage(Sender: TObject; PageIndex: Integer;
|
|
Canvas: TCanvas; PageRect: TRect; PrintRect: TRect;
|
|
var NeedMorePages: Boolean); override;
|
|
procedure DrawControl(ACanvas: TCanvas; AWidth, AHeight: Integer);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property PrintPreview;
|
|
property Control: TControl read FControl write SetControl;
|
|
function CreatePreview(Append: Boolean): Boolean; override;
|
|
property Center: Boolean read FCenter write FCenter default True;
|
|
property Proportional: Boolean read FProportional write FProportional default True;
|
|
property Stretch: Boolean read FStretch write FStretch default True;
|
|
end;
|
|
|
|
TJvNewPageEvent = procedure(Sender: TObject; PageIndex: Integer) of object;
|
|
|
|
// a class that implements the IJvPrinter interface
|
|
TJvPreviewPrinter = class(TJvComponent, IUnknown, IJvPrinter)
|
|
private
|
|
FPrinter: TPrinter;
|
|
FPrintPreview: TJvCustomPreviewControl;
|
|
FCollate: Boolean;
|
|
FToPage: Integer;
|
|
FFromPage: Integer;
|
|
FCopies: Integer;
|
|
FPageIndex: Integer;
|
|
FOptions: TPrintDialogOptions;
|
|
FPrintRange: TPrintRange;
|
|
FOnEndDoc: TNotifyEvent;
|
|
FOnNewPage: TJvNewPageEvent;
|
|
FOnBeginDoc: TNotifyEvent;
|
|
FOnAbort: TNotifyEvent;
|
|
procedure SetPrinterProperty(const Value: TPrinter); // Not called SetPrinter for BCB compatibility
|
|
procedure CheckPrinter;
|
|
procedure CheckActive;
|
|
procedure SetPrintPreview(const Value: TJvCustomPreviewControl);
|
|
procedure SetNumCopies(const Value: Integer);
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
{ IJvPrinter }
|
|
procedure BeginDoc;
|
|
procedure EndDoc;
|
|
function GetAborted: Boolean;
|
|
function GetCanvas: TCanvas;
|
|
function GetPageHeight: Integer;
|
|
function GetPageWidth: Integer;
|
|
function GetPrinting: Boolean;
|
|
function GetHandle: HDC;
|
|
procedure NewPage;
|
|
procedure Abort;
|
|
function GetTitle: string;
|
|
procedure SetTitle(const Value: string);
|
|
public
|
|
procedure Print;
|
|
procedure Assign(Source: TPersistent); override;
|
|
property Title: string read GetTitle write SetTitle;
|
|
property Printer: TPrinter read FPrinter write SetPrinterProperty;
|
|
published
|
|
property Collate: Boolean read FCollate write FCollate default False;
|
|
property Copies: Integer read FCopies write SetNumCopies default 0;
|
|
property FromPage: Integer read FFromPage write FFromPage default 0;
|
|
property Options: TPrintDialogOptions read FOptions write FOptions default [];
|
|
property PrintRange: TPrintRange read FPrintRange write FPrintRange default prAllPages;
|
|
property ToPage: Integer read FToPage write FToPage default 0;
|
|
|
|
property PrintPreview: TJvCustomPreviewControl read FPrintPreview write SetPrintPreview;
|
|
property OnBeginDoc: TNotifyEvent read FOnBeginDoc write FOnBeginDoc;
|
|
property OnNewPage: TJvNewPageEvent read FOnNewPage write FOnNewPage;
|
|
property OnEndDoc: TNotifyEvent read FOnEndDoc write FOnEndDoc;
|
|
property OnAbort: TNotifyEvent read FOnAbort write FOnAbort;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvPrvwRender.pas $';
|
|
Revision: '$Revision: 10612 $';
|
|
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
Forms,
|
|
JvJVCLUtils, JvJCLUtils, JvConsts, JvResources;
|
|
|
|
const
|
|
cTwipsPerInch = 1440;
|
|
|
|
procedure StretchDrawBitmap(Canvas: TCanvas; const ARect: TRect; Bitmap: TBitmap);
|
|
begin
|
|
{$IFDEF VCL}
|
|
if (Canvas = Printer.Canvas) or
|
|
(Printer.Printing and (Canvas.Handle = Printer.Canvas.Handle)) then
|
|
CopyRectDIBits(Canvas, ARect,
|
|
Bitmap, Rect(0, 0, Bitmap.Width, Bitmap.Height))
|
|
else
|
|
{$ENDIF VCL}
|
|
Canvas.StretchDraw(ARect, Bitmap);
|
|
end;
|
|
|
|
type
|
|
TJvCustomPreviewAccessProtected = class(TJvCustomPreviewControl);
|
|
|
|
function CalcDestRect(AWidth, AHeight: Integer; DstRect: TRect; Stretch, Proportional, Center: Boolean): TRect;
|
|
var
|
|
w, h, cw, ch: Integer;
|
|
xyaspect: Double;
|
|
begin
|
|
w := AWidth;
|
|
h := AHeight;
|
|
cw := DstRect.Right - DstRect.Left;
|
|
ch := DstRect.Bottom - DstRect.Top;
|
|
if Stretch or (Proportional and ((w > cw) or (h > ch))) then
|
|
begin
|
|
if Proportional and (w > 0) and (h > 0) then
|
|
begin
|
|
xyaspect := w / h;
|
|
if w > h then
|
|
begin
|
|
w := cw;
|
|
h := Trunc(cw / xyaspect);
|
|
if h > ch then // woops, too big
|
|
begin
|
|
h := ch;
|
|
w := Trunc(ch * xyaspect);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
h := ch;
|
|
w := Trunc(ch * xyaspect);
|
|
if w > cw then // woops, too big
|
|
begin
|
|
w := cw;
|
|
h := Trunc(cw / xyaspect);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
w := cw;
|
|
h := ch;
|
|
end;
|
|
end;
|
|
|
|
with Result do
|
|
begin
|
|
Left := 0;
|
|
Top := 0;
|
|
Right := w;
|
|
Bottom := h;
|
|
end;
|
|
|
|
if Center then
|
|
OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
|
|
OffsetRect(Result, DstRect.Left, DstRect.Top);
|
|
end;
|
|
|
|
//=== { TJvCustomPreviewRenderer } ===========================================
|
|
|
|
function TJvCustomPreviewRenderer.CreatePreview(Append: Boolean): Boolean;
|
|
begin
|
|
Result := False;
|
|
if PrintPreview = nil then
|
|
raise EPrintPreviewError.CreateRes(@RsEAPrintPreviewComponentMustBeAssigne);
|
|
if not Append then
|
|
PrintPreview.Clear;
|
|
FOldAddPage := TJvCustomPreviewAccessProtected(PrintPreview).OnAddPage;
|
|
try
|
|
TJvCustomPreviewAccessProtected(PrintPreview).OnAddPage := InternalDoAddPage;
|
|
PrintPreview.Add;
|
|
finally
|
|
TJvCustomPreviewAccessProtected(PrintPreview).OnAddPage := FOldAddPage;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewRenderer.InternalDoAddPage(Sender: TObject;
|
|
PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
|
|
var NeedMorePages: Boolean);
|
|
begin
|
|
DoAddPage(Sender, PageIndex, Canvas, PageRect, PrintRect, NeedMorePages);
|
|
if Assigned(FOldAddPage) then
|
|
FOldAddPage(Sender, PageIndex, Canvas, PageRect, PrintRect, NeedMorePages);
|
|
end;
|
|
|
|
procedure TJvCustomPreviewRenderer.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = PrintPreview) then
|
|
PrintPreview := nil;
|
|
end;
|
|
|
|
procedure TJvCustomPreviewRenderer.SetPrintPreview(
|
|
const Value: TJvCustomPreviewControl);
|
|
begin
|
|
if FPrintPreview <> Value then
|
|
begin
|
|
if FPrintPreview <> nil then
|
|
FPrintPreview.RemoveFreeNotification(Self);
|
|
FPrintPreview := Value;
|
|
if FPrintPreview <> nil then
|
|
FPrintPreview.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvPreviewRenderRichEdit } ===========================================
|
|
|
|
function TJvPreviewRenderRichEdit.CreatePreview(Append: Boolean): Boolean;
|
|
begin
|
|
if RichEdit = nil then
|
|
raise EPrintPreviewError.CreateRes(@RsEARichEditComponentMustBeAssignedInC);
|
|
Result := RichEdit.Lines.Count > 0;
|
|
FFinished := not Result;
|
|
FLastChar := 0;
|
|
if Result then
|
|
Result := inherited CreatePreview(Append);
|
|
end;
|
|
|
|
procedure TJvPreviewRenderRichEdit.DoAddPage(Sender: TObject;
|
|
PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
|
|
var NeedMorePages: Boolean);
|
|
var
|
|
Range: TFormatRange;
|
|
OutDC: HDC;
|
|
MaxLen, LogX, LogY, OldMap: Integer;
|
|
begin
|
|
FFinished := (RichEdit = nil) or (PrintPreview = nil);
|
|
if not FFinished then
|
|
begin
|
|
FillChar(Range, SizeOf(TFormatRange), 0);
|
|
OutDC := Canvas.Handle;
|
|
Range.hdc := OutDC;
|
|
Range.hdcTarget := OutDC;
|
|
LogX := GetDeviceCaps(OutDC, LOGPIXELSX);
|
|
LogY := GetDeviceCaps(OutDC, LOGPIXELSY);
|
|
if IsRectEmpty(RichEdit.PageRect) then
|
|
begin
|
|
Range.rc.Left := PrintRect.Left * cTwipsPerInch div LogX;
|
|
Range.rc.Top := PrintRect.Top * cTwipsPerInch div LogY;
|
|
Range.rc.Right := PrintRect.Right * cTwipsPerInch div LogX;
|
|
Range.rc.Bottom := PrintRect.Bottom * cTwipsPerInch div LogY;
|
|
end
|
|
else
|
|
begin
|
|
Range.rc.Left := RichEdit.PageRect.Left * cTwipsPerInch div LogX;
|
|
Range.rc.Top := RichEdit.PageRect.Top * cTwipsPerInch div LogY;
|
|
Range.rc.Right := RichEdit.PageRect.Right * cTwipsPerInch div LogX;
|
|
Range.rc.Bottom := RichEdit.PageRect.Bottom * cTwipsPerInch div LogY;
|
|
end;
|
|
Range.rcPage := Range.rc;
|
|
|
|
MaxLen := RichEdit.GetTextLen;
|
|
|
|
Range.chrg.cpMax := -1;
|
|
|
|
// ensure the output DC is in text map mode
|
|
OldMap := SetMapMode(Range.hdc, MM_TEXT);
|
|
try
|
|
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
|
|
Range.chrg.cpMin := FLastChar;
|
|
FLastChar := SendMessage(RichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
|
|
FFinished := (FLastChar >= MaxLen) or (FLastChar = -1);
|
|
NeedMorePages := not FFinished;
|
|
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
|
|
finally
|
|
SetMapMode(OutDC, OldMap);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderRichEdit.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = RichEdit) then
|
|
RichEdit := nil;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderRichEdit.SetRichEdit(
|
|
const Value: TCustomRichEdit);
|
|
begin
|
|
if FRichEdit <> Value then
|
|
begin
|
|
if FRichEdit <> nil then
|
|
FRichEdit.RemoveFreeNotification(Self);
|
|
FRichEdit := Value;
|
|
if FRichEdit <> nil then
|
|
FRichEdit.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvPreviewRenderJvRichEdit } =========================================
|
|
|
|
function TJvPreviewRenderJvRichEdit.CreatePreview(Append: Boolean): Boolean;
|
|
begin
|
|
if RichEdit = nil then
|
|
raise EPrintPreviewError.CreateRes(@RsEARichEditComponentMustBeAssignedInC);
|
|
Result := RichEdit.Lines.Count > 0;
|
|
FFinished := not Result;
|
|
FLastChar := 0;
|
|
if Result then
|
|
Result := inherited CreatePreview(Append);
|
|
end;
|
|
|
|
procedure TJvPreviewRenderJvRichEdit.DoAddPage(Sender: TObject;
|
|
PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
|
|
var NeedMorePages: Boolean);
|
|
var
|
|
Range: TFormatRange;
|
|
OutDC: HDC;
|
|
ALastChar, MaxLen, LogX, LogY, OldMap: Integer;
|
|
TextLenEx: TGetTextLengthEx;
|
|
begin
|
|
FFinished := (RichEdit = nil) or (PrintPreview = nil);
|
|
if not FFinished then
|
|
begin
|
|
FillChar(Range, SizeOf(TFormatRange), 0);
|
|
OutDC := Canvas.Handle;
|
|
Range.hdc := OutDC;
|
|
Range.hdcTarget := OutDC;
|
|
LogX := GetDeviceCaps(OutDC, LOGPIXELSX);
|
|
LogY := GetDeviceCaps(OutDC, LOGPIXELSY);
|
|
if IsRectEmpty(RichEdit.PageRect) then
|
|
begin
|
|
Range.rc.Left := PrintRect.Left * cTwipsPerInch div LogX;
|
|
Range.rc.Top := PrintRect.Top * cTwipsPerInch div LogY;
|
|
Range.rc.Right := PrintRect.Right * cTwipsPerInch div LogX;
|
|
Range.rc.Bottom := PrintRect.Bottom * cTwipsPerInch div LogY;
|
|
end
|
|
else
|
|
begin
|
|
Range.rc.Left := RichEdit.PageRect.Left * cTwipsPerInch div LogX;
|
|
Range.rc.Top := RichEdit.PageRect.Top * cTwipsPerInch div LogY;
|
|
Range.rc.Right := RichEdit.PageRect.Right * cTwipsPerInch div LogX;
|
|
Range.rc.Bottom := RichEdit.PageRect.Bottom * cTwipsPerInch div LogY;
|
|
end;
|
|
Range.rcPage := Range.rc;
|
|
if RichEditVersion >= 2 then
|
|
begin
|
|
with TextLenEx do
|
|
begin
|
|
Flags := GTL_DEFAULT;
|
|
codepage := CP_ACP;
|
|
end;
|
|
MaxLen := RichEdit.Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
|
|
end
|
|
else
|
|
MaxLen := RichEdit.GetTextLen;
|
|
|
|
Range.chrg.cpMax := -1;
|
|
|
|
// ensure the output DC is in text map mode
|
|
OldMap := SetMapMode(Range.hdc, MM_TEXT);
|
|
try
|
|
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
|
|
Range.chrg.cpMin := FLastChar;
|
|
ALastChar := SendMessage(RichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
|
|
FFinished := (ALastChar >= MaxLen) or (ALastChar = -1) or (ALastChar <= FLastChar);
|
|
FLastChar := ALastChar;
|
|
NeedMorePages := not FFinished;
|
|
if FFinished then
|
|
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
|
|
finally
|
|
SetMapMode(OutDC, OldMap);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderJvRichEdit.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = RichEdit) then
|
|
RichEdit := nil;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderJvRichEdit.SetRichEdit(const Value: TJvCustomRichEdit);
|
|
begin
|
|
if FRichEdit <> Value then
|
|
begin
|
|
if FRichEdit <> nil then
|
|
FRichEdit.RemoveFreeNotification(Self);
|
|
FRichEdit := Value;
|
|
if FRichEdit <> nil then
|
|
FRichEdit.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvPreviewRenderStrings } ============================================
|
|
|
|
constructor TJvPreviewRenderStrings.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FStrings := TStringList.Create;
|
|
FFont := TFont.Create;
|
|
end;
|
|
|
|
function TJvPreviewRenderStrings.CreatePreview(Append: Boolean): Boolean;
|
|
begin
|
|
Result := Strings.Count > 0;
|
|
FFinished := not Result;
|
|
FCurrentRow := 0;
|
|
if Result then
|
|
Result := inherited CreatePreview(Append);
|
|
end;
|
|
|
|
destructor TJvPreviewRenderStrings.Destroy;
|
|
begin
|
|
FStrings.Free;
|
|
FFont.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderStrings.DoAddPage(Sender: TObject;
|
|
PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
|
|
var NeedMorePages: Boolean);
|
|
var
|
|
i, IncValue: Integer;
|
|
ARect: TRect;
|
|
tm: TTextMetric;
|
|
S: string;
|
|
begin
|
|
if not FFinished then
|
|
begin
|
|
Canvas.Font := Font;
|
|
ARect := PrintRect;
|
|
|
|
GetTextMetrics(Canvas.Handle, tm);
|
|
IncValue := CanvasMaxTextHeight(Canvas) + tm.tmInternalLeading + tm.tmExternalLeading;
|
|
ARect.Bottom := ARect.Top + IncValue;
|
|
for i := FCurrentRow to Strings.Count - 1 do
|
|
begin
|
|
ARect.Right := PrintRect.Right;
|
|
S := Strings[i];
|
|
IncValue := DrawText(Canvas, PChar(S), Length(S), ARect,
|
|
DT_CALCRECT or DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
|
|
if ARect.Right > PrintRect.Right then
|
|
begin
|
|
ARect.Right := PrintRect.Right; // reset and just force a line break in the middle (not fail proof!)
|
|
S := Copy(S, 1, Length(S) div 2) + CrLf +
|
|
Copy(S, Length(S) div 2 + 1, Length(S));
|
|
IncValue := DrawText(Canvas, PChar(S), Length(S), ARect,
|
|
DT_CALCRECT or DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
|
|
end;
|
|
if ARect.Bottom > PrintRect.Bottom then
|
|
begin
|
|
FCurrentRow := i;
|
|
NeedMorePages := True;
|
|
Exit;
|
|
end;
|
|
DrawText(Canvas, PChar(S), Length(S), ARect,
|
|
DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
|
|
OffsetRect(ARect, 0, IncValue);
|
|
end;
|
|
end;
|
|
FFinished := True;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderStrings.SetFont(const Value: TFont);
|
|
begin
|
|
FFont.Assign(Value);
|
|
end;
|
|
|
|
function TJvPreviewRenderStrings.GetStrings: TStrings;
|
|
begin
|
|
Result := FStrings;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderStrings.SetStrings(const Value: TStrings);
|
|
begin
|
|
FStrings.Assign(Value);
|
|
end;
|
|
|
|
//=== { TJvPreviewRenderControl } ============================================
|
|
|
|
function TJvPreviewRenderControl.CreatePreview(Append: Boolean): Boolean;
|
|
begin
|
|
Result := Control <> nil;
|
|
if Result then
|
|
Result := inherited CreatePreview(Append);
|
|
end;
|
|
|
|
procedure TJvPreviewRenderControl.DoAddPage(Sender: TObject;
|
|
PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
|
|
var NeedMorePages: Boolean);
|
|
var
|
|
Bitmap: TBitmap;
|
|
ARect: TRect;
|
|
begin
|
|
NeedMorePages := False;
|
|
Bitmap := TBitmap.Create;
|
|
try
|
|
if Control is TCustomForm then
|
|
begin
|
|
Bitmap.Width := Control.ClientWidth;
|
|
Bitmap.Height := Control.ClientHeight;
|
|
end
|
|
else
|
|
begin
|
|
Bitmap.Width := Control.Width;
|
|
Bitmap.Height := Control.Height;
|
|
end;
|
|
Bitmap.PixelFormat := pf32bit;
|
|
Bitmap.HandleType := bmDIB;
|
|
Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
|
|
DrawControl(Bitmap.Canvas, Bitmap.Width, Bitmap.Height);
|
|
if (Bitmap.Width > 0) and (Bitmap.Height > 0) then
|
|
begin
|
|
ARect := CalcDestRect(Bitmap.Width, Bitmap.Height, PrintRect, Stretch,
|
|
Proportional, Center);
|
|
StretchDrawBitmap(Canvas, ARect, Bitmap);
|
|
end;
|
|
finally
|
|
Bitmap.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderControl.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = Control) then
|
|
Control := nil;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderControl.SetControl(const Value: TControl);
|
|
begin
|
|
if FControl <> Value then
|
|
begin
|
|
if FControl <> nil then
|
|
FControl.RemoveFreeNotification(Self);
|
|
FControl := Value;
|
|
if FControl <> nil then
|
|
FControl.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderControl.DrawControl(ACanvas: TCanvas; AWidth, AHeight: Integer);
|
|
var
|
|
SaveIndex: Integer;
|
|
ADC: HDC;
|
|
begin
|
|
ACanvas.Lock;
|
|
try
|
|
ADC := ACanvas.Handle;
|
|
if Control is TWinControl then
|
|
TWinControl(Control).PaintTo(ADC, 0, 0)
|
|
else
|
|
if Control <> nil then
|
|
begin
|
|
SaveIndex := SaveDC(ADC);
|
|
try
|
|
Control.ControlState := Control.ControlState + [csPaintCopy];
|
|
MoveWindowOrg(ADC, 0, 0);
|
|
IntersectClipRect(ADC, 0, 0, Control.Width, Control.Height);
|
|
Control.Perform(WM_ERASEBKGND, ADC, 0);
|
|
Control.Perform(WM_PAINT, ADC, 0);
|
|
finally
|
|
RestoreDC(ADC, SaveIndex);
|
|
Control.ControlState := Control.ControlState - [csPaintCopy];
|
|
end;
|
|
end
|
|
finally
|
|
ACanvas.Unlock;
|
|
end;
|
|
end;
|
|
|
|
constructor TJvPreviewRenderControl.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FStretch := True;
|
|
FProportional := True;
|
|
FCenter := True;
|
|
end;
|
|
|
|
//=== { TJvPreviewGraphicItems } =============================================
|
|
|
|
function TJvPreviewGraphicItems.Add: TJvPreviewGraphicItem;
|
|
begin
|
|
Result := TJvPreviewGraphicItem(inherited Add);
|
|
end;
|
|
|
|
constructor TJvPreviewGraphicItems.Create(AOwner: TPersistent);
|
|
begin
|
|
inherited Create(AOwner, TJvPreviewGraphicItem);
|
|
end;
|
|
|
|
function TJvPreviewGraphicItems.GetItems(
|
|
Index: Integer): TJvPreviewGraphicItem;
|
|
begin
|
|
Result := TJvPreviewGraphicItem(inherited Items[Index]);
|
|
end;
|
|
|
|
procedure TJvPreviewGraphicItems.SetItems(Index: Integer;
|
|
const Value: TJvPreviewGraphicItem);
|
|
begin
|
|
inherited Items[Index] := Value;
|
|
end;
|
|
|
|
//=== { TJvPreviewGraphicItem } ==============================================
|
|
|
|
constructor TJvPreviewGraphicItem.Create(Collection: TCollection);
|
|
begin
|
|
inherited Create(Collection);
|
|
FPicture := TPicture.Create;
|
|
FCenter := True;
|
|
FProportional := True;
|
|
FStretch := True;
|
|
end;
|
|
|
|
function TJvPreviewGraphicItem.DestRect(RefRect: TRect; DestDC: HDC): TRect;
|
|
// var Points: TPoint;
|
|
begin
|
|
UpdateGraphic;
|
|
Result := CalcDestRect(Picture.Width, Picture.Height, RefRect, Stretch, Proportional, Center);
|
|
end;
|
|
|
|
destructor TJvPreviewGraphicItem.Destroy;
|
|
begin
|
|
FPicture.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvPreviewGraphicItem.SetPicture(const Value: TPicture);
|
|
begin
|
|
FPicture.Assign(Value);
|
|
end;
|
|
|
|
procedure TJvPreviewGraphicItem.UpdateGraphic;
|
|
var
|
|
G: TGraphic;
|
|
begin
|
|
if (Picture.Width > 0) and (Picture.Height > 0) then
|
|
begin
|
|
G := Picture.Graphic;
|
|
if (G <> nil) and not ((G is TMetaFile) or (G is TIcon)) then
|
|
G.Transparent := Transparent;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvPreviewRenderGraphics } ===========================================
|
|
|
|
constructor TJvPreviewRenderGraphics.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FImages := TJvPreviewGraphicItems.Create(Self);
|
|
end;
|
|
|
|
function TJvPreviewRenderGraphics.CreatePreview(Append: Boolean): Boolean;
|
|
begin
|
|
Result := FImages.Count > 0;
|
|
if Result then
|
|
Result := inherited CreatePreview(Append);
|
|
end;
|
|
|
|
destructor TJvPreviewRenderGraphics.Destroy;
|
|
begin
|
|
FImages.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvPreviewRenderGraphics.DoAddPage(Sender: TObject;
|
|
PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
|
|
var NeedMorePages: Boolean);
|
|
var
|
|
Img: TImageList;
|
|
begin
|
|
with Images[PageIndex] do
|
|
if (PageIndex < Images.Count) and (Picture.Height > 0) and (Picture.Width > 0) and
|
|
(Picture.Graphic <> nil) and not Picture.Graphic.Empty then
|
|
begin
|
|
if Picture.Graphic is TIcon then
|
|
begin
|
|
Img := TImageList.CreateSize(Picture.Width, Picture.Height);
|
|
try
|
|
Img.AddIcon(Picture.Icon);
|
|
Img.GetBitmap(0, Picture.Bitmap);
|
|
finally
|
|
Img.Free;
|
|
end;
|
|
end;
|
|
if Picture.Graphic is TBitmap then
|
|
StretchDrawBitmap(Canvas, DestRect(PrintRect, Canvas.Handle), Picture.Bitmap)
|
|
else
|
|
Canvas.StretchDraw(DestRect(PrintRect, Canvas.Handle), Picture.Graphic);
|
|
end;
|
|
NeedMorePages := PageIndex < Images.Count - 1;
|
|
end;
|
|
|
|
function TJvPreviewRenderGraphics.GetPPX(ADC: HDC): Integer;
|
|
begin
|
|
Result := GetDeviceCaps(ADC, LOGPIXELSX);
|
|
end;
|
|
|
|
function TJvPreviewRenderGraphics.GetPPY(ADC: HDC): Integer;
|
|
begin
|
|
Result := GetDeviceCaps(ADC, LOGPIXELSY);
|
|
end;
|
|
|
|
procedure TJvPreviewRenderGraphics.SetImages(const Value: TJvPreviewGraphicItems);
|
|
begin
|
|
FImages.Assign(Value);
|
|
end;
|
|
|
|
//=== { TJvPreviewPrinter } ==================================================
|
|
|
|
procedure TJvPreviewPrinter.Abort;
|
|
begin
|
|
CheckPrinter;
|
|
if GetPrinting then
|
|
FPrinter.Abort;
|
|
if Assigned(FOnAbort) then
|
|
FOnAbort(Self);
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.Assign(Source: TPersistent);
|
|
begin
|
|
CheckActive;
|
|
if Source is TJvPreviewPrinter then
|
|
begin
|
|
Collate := TJvPreviewPrinter(Source).Collate;
|
|
Copies := TJvPreviewPrinter(Source).Copies;
|
|
FromPage := TJvPreviewPrinter(Source).FromPage;
|
|
Options := TJvPreviewPrinter(Source).Options;
|
|
PrintRange := TJvPreviewPrinter(Source).PrintRange;
|
|
ToPage := TJvPreviewPrinter(Source).ToPage;
|
|
Title := TJvPreviewPrinter(Source).Title;
|
|
end
|
|
else
|
|
if Source is TPrintDialog then
|
|
begin
|
|
Collate := TPrintDialog(Source).Collate;
|
|
Copies := TPrintDialog(Source).Copies;
|
|
FromPage := TPrintDialog(Source).FromPage;
|
|
Options := TPrintDialog(Source).Options;
|
|
PrintRange := TPrintDialog(Source).PrintRange;
|
|
ToPage := TPrintDialog(Source).ToPage;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.BeginDoc;
|
|
begin
|
|
CheckPrinter;
|
|
FPrinter.BeginDoc;
|
|
if Assigned(FOnBeginDoc) then
|
|
FOnBeginDoc(Self);
|
|
FPageIndex := 0;
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.CheckActive;
|
|
begin
|
|
if (Printer <> nil) and GetPrinting then
|
|
raise EPrintPreviewError.CreateRes(@RsECannotPerfromThisOperationWhilePrin);
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.CheckPrinter;
|
|
begin
|
|
if Printer = nil then
|
|
raise EPrintPreviewError.CreateRes(@RsEPrinterNotAssigned);
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.EndDoc;
|
|
begin
|
|
CheckPrinter;
|
|
FPrinter.EndDoc;
|
|
if Assigned(FOnEndDoc) then
|
|
FOnEndDoc(Self);
|
|
end;
|
|
|
|
function TJvPreviewPrinter.GetAborted: Boolean;
|
|
begin
|
|
CheckPrinter;
|
|
Result := FPrinter.Aborted;
|
|
end;
|
|
|
|
function TJvPreviewPrinter.GetCanvas: TCanvas;
|
|
begin
|
|
CheckPrinter;
|
|
Result := FPrinter.Canvas;
|
|
end;
|
|
|
|
function TJvPreviewPrinter.GetHandle: HDC;
|
|
begin
|
|
CheckPrinter;
|
|
Result := FPrinter.Handle;
|
|
end;
|
|
|
|
function TJvPreviewPrinter.GetPageHeight: Integer;
|
|
begin
|
|
CheckPrinter;
|
|
Result := FPrinter.PageHeight;
|
|
end;
|
|
|
|
function TJvPreviewPrinter.GetPageWidth: Integer;
|
|
begin
|
|
CheckPrinter;
|
|
Result := FPrinter.PageWidth;
|
|
end;
|
|
|
|
function TJvPreviewPrinter.GetPrinting: Boolean;
|
|
begin
|
|
CheckPrinter;
|
|
Result := FPrinter.Printing;
|
|
end;
|
|
|
|
function TJvPreviewPrinter.GetTitle: string;
|
|
begin
|
|
CheckPrinter;
|
|
Result := FPrinter.Title;
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.NewPage;
|
|
begin
|
|
CheckPrinter;
|
|
FPrinter.NewPage;
|
|
if Assigned(FOnNewPage) then
|
|
FOnNewPage(Self, FPageIndex);
|
|
Inc(FPageIndex);
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = PrintPreview) then
|
|
PrintPreview := nil;
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.Print;
|
|
var
|
|
AMin, AMax: Integer;
|
|
begin
|
|
if PrintPreview = nil then
|
|
raise EPrintPreviewError.CreateRes(@RsENoPrintPreviewAssigned);
|
|
if PrintRange = prAllPages then
|
|
begin
|
|
AMin := 0;
|
|
AMax := PrintPreview.PageCount - 1;
|
|
end
|
|
else
|
|
begin
|
|
AMin := FromPage - 1;
|
|
AMax := ToPage - 1;
|
|
end;
|
|
PrintPreview.PrintRange(Self, AMin, AMax, Copies, Collate);
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.SetNumCopies(const Value: Integer);
|
|
begin
|
|
FCopies := Value;
|
|
if FCopies < 1 then
|
|
FCopies := 1;
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.SetPrinterProperty(const Value: TPrinter);
|
|
begin
|
|
CheckActive;
|
|
FPrinter := Value;
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.SetPrintPreview(const Value: TJvCustomPreviewControl);
|
|
begin
|
|
CheckActive;
|
|
if FPrintPreview <> Value then
|
|
begin
|
|
if FPrintPreview <> nil then
|
|
FPrintPreview.RemoveFreeNotification(Self);
|
|
FPrintPreview := Value;
|
|
if FPrintPreview <> nil then
|
|
FPrintPreview.FreeNotification(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvPreviewPrinter.SetTitle(const Value: string);
|
|
begin
|
|
CheckPrinter;
|
|
FPrinter.Title := Value;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|