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

