jvprvwrender.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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 Th鰎nqvist.
Portions created by Peter Th鰎nqvist are Copyright (c) 2003 by Peter Th鰎nqvist.
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,v 1.28 2005/02/17 10:20:46 marquardt Exp $

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,
  JvComponent, 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 SetPrinter(const Value: TPrinter);
    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;
    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 SetPrinter;
  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: '$RCSfile: JvPrvwRender.pas,v $';
    Revision: '$Revision: 1.28 $';
    Date: '$Date: 2005/02/17 10:20:46 $';
    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;