pjimagelist.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.001                            *)
(*  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 PJImageList;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, PSJob, Printers,
  Controls;

type

  TCustomImageListPrintJob = class(TCustomPrintJob)
  private
    { Private declarations }
    FImageList: TImageList;
    FStretchMode: TStretchMode;
    FAlignVertical: TAlignVertical;
    FAlignHorizontal: TAlignHorizontal;
    procedure SetImageList(const Value: TImageList);
    procedure SetStretchMode(const Value: TStretchMode);
    procedure SetAlignVertical(const Value: TAlignVertical);
    procedure SetAlignHorizontal(const Value: TAlignHorizontal);
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure DrawArea(TheCanvas: TCanvas; PageIndex: Integer; TheRect: TRect; Area: TDrawArea; Target: TDrawTarget); override;
    property ImageList: TImageList read FImageList write SetImageList;
    property StretchMode: TStretchMode read FStretchMode write SetStretchMode;
    property AlignVertical: TAlignVertical read FAlignVertical write SetAlignVertical;
    property AlignHorizontal: TAlignHorizontal read FAlignHorizontal write SetAlignHorizontal;
  published
    { Published declarations }
  end;

  TImageListPrintJob = class(TCustomImageListPrintJob)
  published
    // TCustomImageListPrintJob properties
    property ImageList;
    property StretchMode;
    property AlignVertical;
    property AlignHorizontal;
    // 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;
    // TCustomPrintJob events
    property OnCreate;
    property OnDestroy;
    property OnDraw;
    property OnPrinterSetupChange;
    property OnStartPrint;
    property OnEndPrint;
    property OnPrintProgress;
    property OnStartPrintPage;
    property OnEndPrintPage;
    property OnUpdate;
  end;

implementation

procedure TCustomImageListPrintJob.SetImageList(const Value: TImageList);
begin
  if FImageList<>Value then
  begin
    FImageList:=Value;
    if Assigned(FImageList) then PageCount:=FImageList.Count
    else PageCount:=1;
  end;
end;

procedure TCustomImageListPrintJob.SetStretchMode(const Value: TStretchMode);
begin
  if Value<>FStretchMode then
  begin
    FStretchMode:=Value;
    Update;
  end;
end;

procedure TCustomImageListPrintJob.SetAlignVertical(const Value: TAlignVertical);
begin
  if Value<>FAlignVertical then
  begin
    FAlignVertical:=Value;
    Update;
  end;
end;

procedure TCustomImageListPrintJob.SetAlignHorizontal(const Value: TAlignHorizontal);
begin
  if Value<>FAlignHorizontal then
  begin
    FAlignHorizontal:=Value;
    Update;
  end;
end;

procedure TCustomImageListPrintJob.DrawArea(TheCanvas: TCanvas; PageIndex: Integer;
  TheRect: TRect; Area: TDrawArea; Target: TDrawTarget);
var
  BMP: TBitmap;
  RGN: HRGN;
begin
  if (Area=daPage) and Assigned(FImageList) and (FImageList.Count>0) and (PageIndex<=FImageList.Count) then
  begin
    with TheRect,TheCanvas do
    begin
      RGN:=0;
      GetClipRgn(Handle,RGN);
      IntersectClipRect(Handle,Left,Top,Right,Bottom);
      try
        BMP:=TBitmap.Create;
        try
          FImageList.GetBitmap(Pred(PageIndex),BMP);
          StretchBitmap(TheCanvas,TheRect,BMP,FStretchMode,FAlignHorizontal,FAlignVertical,Target)
        finally
          BMP.Free;
        end;
      finally
        SelectClipRgn(Handle,RGN);
      end;
    end;
  end
  else inherited;
end;

end.