pjrichedit.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

(*  GREATIS PRINT SUITE PRO                          *)
(*  unit version 1.85.014                            *)
(*  Copyright (C) 2001-2007 Greatis Software         *)
(*  http://www.greatis.com/delphicb/printsuite/      *)
(*  http://www.greatis.com/delphicb/printsuite/faq/  *)
(*  http://www.greatis.com/bteam.html                *)

unit PJRichEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PSJob, Printers, ComCtrls,
  {$IFDEF PSRXRICHEDIT}
  RxRichEd,
  {$ENDIF}
  RichEdit;

type

  TPageRange = class
  public
    StartChar,EndChar: Integer;
    constructor Create(AStartChar,AEndChar: Integer);
  end;

  TCustomRichEditPrintJob = class(TCustomPrintJob)
  private
    { Private declarations }
    FPages: TList;
    {$IFDEF PSRXRICHEDIT}
    FRichEdit: TRxCustomRichEdit;
    {$ELSE}
    FRichEdit: TCustomRichEdit;
    {$ENDIF}
    FOnUpdateProgress: TPSProgressEvent;
    {$IFDEF PSRXRICHEDIT}
    procedure SetRichEdit(const Value: TRxCustomRichEdit);
    {$ELSE}
    procedure SetRichEdit(const Value: TCustomRichEdit);
    {$ENDIF}
    procedure ClearPages;
  protected
    { Protected declarations }
    {$IFDEF PSRXRICHEDIT}
    property RichEdit: TRxCustomRichEdit read FRichEdit write SetRichEdit;
    {$ELSE}
    property RichEdit: TCustomRichEdit read FRichEdit write SetRichEdit;
    {$ENDIF}
    property OnUpdateProgress: TPSProgressEvent read FOnUpdateProgress write FOnUpdateProgress;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; override;
    procedure DrawArea(TheCanvas: TCanvas; PageIndex: Integer; TheRect: TRect; Area: TDrawArea; Target: TDrawTarget); override;
  published
    { Published declarations }
  end;

  TRichEditPrintJob = class(TCustomRichEditPrintJob)
  published
    // TCustomRichEditPrintJob properties
    property RichEdit;
    property OnUpdateProgress;
    // TCustomPrintJob properties
    property MultiDoc;
    property Title;
    property Margins;
    property MarginsUnits;
    property MarginsError;
    property Header;
    property HeaderUnits;
    property Footer;
    property FooterUnits;
    property PageMode;
    property PageWidth;
    property PageHeight;
    property PageUnits;
    property Orientation;
    property Options;
    property RelativeCoords;
    property DefaultDrawing;
    property OnCreate;
    property OnDestroy;
    property OnDraw;
    property OnPrinterSetupChange;
    property OnStartPrint;
    property OnEndPrint;
    property OnPrintProgress;
    property OnStartPrintPage;
    property OnEndPrintPage;
    property OnUpdate;
  end;

procedure Register;

implementation

constructor TPageRange.Create(AStartChar,AEndChar: Integer);
begin
  StartChar:=AStartChar;
  EndChar:=AEndChar;
end;

{$IFDEF PSRXRICHEDIT}
procedure TCustomRichEditPrintJob.SetRichEdit(const Value: TRxCustomRichEdit);
{$ELSE}
procedure TCustomRichEditPrintJob.SetRichEdit(const Value: TCustomRichEdit);
{$ENDIF}
begin
  FRichEdit:=Value;
  Update;
end;

procedure TCustomRichEditPrintJob.ClearPages;
var
  i: Integer;
begin
  with FPages do
  begin
    for i:=0 to Pred(Count) do TPageRange(Items[i]).Free;
    Clear;
    Capacity:=0;
  end;
end;

constructor TCustomRichEditPrintJob.Create(AOwner: TComponent);
begin
  inherited;
  FPages:=TList.Create;
end;

destructor TCustomRichEditPrintJob.Destroy;
begin
  ClearPages;
  FPages.Free;
  inherited;
end;

procedure TCustomRichEditPrintJob.Update;
var
  FR: TFormatRange;
  LastChar,TextLen: Integer;
begin
  ClearPages;
  LockUpdate;
  try
    if PrinterOK and (Assigned(FRichEdit)) then
    begin
      FillChar(FR,SizeOf(FR),0);
      with FR do
      begin
        hdc:=Printer.Handle;
        hdcTarget:=hdc;
        rc:=GetPageRect;
        with rc do
        begin
          Left:=Left*1440 div DPIX;
          Top:=Top*1440 div DPIY;
          Right:=Right*1440 div DPIX;
          Bottom:=Bottom*1440 div DPIY;
        end;
        rcPage:=rc;
        LastChar:=0;
        TextLen:=FRichEdit.GetTextLen;
        chrg.cpMax:=-1;
        if Assigned(FOnUpdateProgress) then FOnUpdateProgress(Self,0,0,TextLen);
        SendMessage(FRichEdit.Handle,EM_FORMATRANGE,0,0);
        try
          with FPages do
          begin
            repeat
              chrg.cpMin:=LastChar;
              LastChar:=SendMessage(FRichEdit.Handle,EM_FORMATRANGE,0,Integer(@FR));
              rc:=rcPage;
              if LastChar=-1 then LastChar:=TextLen;
              if chrg.cpMin<LastChar then
              begin
                Add(TPageRange.Create(chrg.cpMin,LastChar));
                if Assigned(FOnUpdateProgress) then FOnUpdateProgress(Self,0,LastChar,TextLen);
              end;
            until (LastChar>=TextLen) or (chrg.cpMin=LastChar);
            if Count=0 then Add(TPageRange.Create(chrg.cpMin,LastChar));
            PageCount:=Count;
          end;
        finally
          SendMessage(FRichEdit.Handle,EM_FORMATRANGE,0,0);
        end;
      end;
    end
    else PageCount:=1;
  finally
    UnlockUpdate;
  end;
  inherited;
end;

procedure TCustomRichEditPrintJob.DrawArea(TheCanvas: TCanvas; PageIndex: Integer;
  TheRect: TRect; Area: TDrawArea; Target: TDrawTarget);
var
  FR: TFormatRange;
  OldWindow: TSize;
begin
  with TheCanvas do
  begin
    if (Area=daPage) and (Pred(PageIndex)<FPages.Count) then
    begin
      FillChar(FR,SizeOf(FR),0);
      with FR,TheRect do
      begin
        hdc:=Handle;
        hdcTarget:=hdc;
        rc.Left:=Left*1440 div DPIX;
        rc.Top:=Top*1440 div DPIY;
        rc.Right:=Right*1440 div DPIX;
        rc.Bottom:=GetPrintableRect.Bottom*1440 div DPIY;
        rcPage:=rc;
        if Target=dtPreview then
          SetWindowExtEx(
            Handle,
            Trunc(ConvertUnits(GetDeviceCaps(Handle,LOGPIXELSX)*PageWidth/DPIX,PageUnits,unPixels,dirHorizontal,PhysicalPageWidth)),
            Trunc(ConvertUnits(GetDeviceCaps(Handle,LOGPIXELSY)*PageHeight/DPIY,PageUnits,unPixels,dirVertical,PhysicalPageHeight)),
            @OldWindow);
        try
          with FPages,TPageRange(Items[Pred(PageIndex)]),chrg do
          begin
            cpMin:=StartChar;
            cpMax:=EndChar;
          end;
          SendMessage(FRichEdit.Handle,EM_FORMATRANGE,0,0);
          try
            SendMessage(FRichEdit.Handle,EM_FORMATRANGE,1,Integer(@FR));
          finally
            SendMessage(FRichEdit.Handle,EM_FORMATRANGE,0,0);
          end;
        finally
          if Target=dtPreview then
            with OldWindow do SetWindowExtEx(Handle,CX,CY,nil);
        end;
      end;
    end
    else inherited;
  end;
end;

procedure Register;
begin
  RegisterComponents('Print Jobs', [TRichEditPrintJob]);
end;

end.