pjbitmap.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.010                            *)
(*  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 PJBitmap;

interface

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

type
  TCustomBitmapPrintJob = class(TCustomPrintJob)
  private
    { Private declarations }
    FBitmap: TBitmap;
    FStretchMode: TStretchMode;
    FScale: Integer;
    FMultiPage: Boolean;
    FAlignVertical: TAlignVertical;
    FAlignHorizontal: TAlignHorizontal;
    FPageHor: Integer;
    FPageVer: Integer;
    procedure SetStretchMode(const Value: TStretchMode);
    procedure SetScale(const Value: Integer);
    procedure SetMultiPage(const Value: Boolean);
    procedure SetAlignVertical(const Value: TAlignVertical);
    procedure SetAlignHorizontal(const Value: TAlignHorizontal);
    procedure GetMD(var M,D: Integer); virtual;
    procedure CalculatePageCount; virtual;
  protected
    { Protected declarations }
    procedure ClearBitmap;
  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;
    procedure GetBitmap(const Bitmap: TBitmap); virtual; abstract;
    procedure UpdateBitmap;
    property StretchMode: TStretchMode read FStretchMode write SetStretchMode default sm1x1;
    property Scale: Integer read FScale write SetScale default 100;
    property MultiPage: Boolean read FMultiPage write SetMultiPage default False;
    property AlignVertical: TAlignVertical read FAlignVertical write SetAlignVertical default avTop;
    property AlignHorizontal: TAlignHorizontal read FAlignHorizontal write SetAlignHorizontal default ahLeft;
  published
    { Published declarations }
  end;

implementation

procedure TCustomBitmapPrintJob.SetStretchMode(const Value: TStretchMode);
var
  M,D: Integer;
begin
  if Value<>FStretchMode then
  begin
    FStretchMode:=Value;
    case FStretchMode of
      sm1x1,sm50,sm75,sm125,sm150,sm175,sm200:
      begin
        GetMD(M,D);
        FScale:=M*100 div D;
      end;
    end;
    Update;
  end;
end;

procedure TCustomBitmapPrintJob.SetScale(const Value: Integer);
begin
  if (FStretchMode=smCustom) and (Value<>FScale) then
  begin
    FScale:=Value;
    if FScale<1 then FScale:=1;
    Update;
  end;
end;

procedure TCustomBitmapPrintJob.SetMultiPage(const Value: Boolean);
begin
  if Value<>FMultiPage then
  begin
    FMultiPage:=Value;
    CalculatePageCount;
    Update;
  end;
end;

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

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

procedure TCustomBitmapPrintJob.GetMD(var M,D: Integer);
begin
  case FStretchMode of
    sm50:
    begin
      M:=1;
      D:=2;
    end;
    sm75:
    begin
      M:=3;
      D:=4;
    end;
    sm125:
    begin
      M:=5;
      D:=4;
    end;
    sm150:
    begin
      M:=3;
      D:=2;
    end;
    sm175:
    begin
      M:=7;
      D:=4;
    end;
    sm200:
    begin
      M:=2;
      D:=1;
    end;
    smCustom:
    begin
      M:=FScale;
      D:=100;
    end;
  else
    M:=1;
    D:=1;
  end;
end;

procedure TCustomBitmapPrintJob.CalculatePageCount;
var
  R: TRect;
  M,D: Integer;
begin
  if FMultiPage and Assigned(FBitmap) and not FBitmap.Empty then
  begin
    R:=GetPageRect;
    with R,FBitmap do
      case FStretchMode of
        smFit,smStretch: PageCount:=1;
        smFitToWidth:
          PageCount:=Succ(Height*((Right-Left) div Width) div (Bottom-Top));
        smFitToHeight:
          PageCount:=Succ(Width*((Bottom-Top) div Height) div (Right-Left));
        sm1x1,sm50,sm75,sm125,sm150,sm175,sm200,smCustom:
        begin
          GetMD(M,D);
          FPageHor:=Succ((M*Width div D) div (Right-Left));
          FPageVer:=Succ((M*Height div D) div (Bottom-Top));
          PageCount:=FPageHor*FPageVer;
        end;
      end;
  end
  else PageCount:=1;
end;

constructor TCustomBitmapPrintJob.Create(AOwner: TComponent);
begin
  inherited;
  FBitmap:=TBitmap.Create;
  FScale:=100;
end;

destructor TCustomBitmapPrintJob.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TCustomBitmapPrintJob.Update;
begin
  CalculatePageCount;
  inherited Update;
end;

procedure TCustomBitmapPrintJob.DrawArea(TheCanvas: TCanvas; PageIndex: Integer;
  TheRect: TRect; Area: TDrawArea; Target: TDrawTarget);
var
  RGN: HRGN;
  R: TRect;
  W,H,M,D: Integer;
begin
  if Area=daPage then
  begin
    with TheRect,TheCanvas do
    begin
      RGN:=0;
      GetClipRgn(Handle,RGN);
      IntersectClipRect(Handle,Left,Top,Right,Bottom);
      try
        if FMultiPage then
        begin
          case FStretchMode of
            smFitToHeight:
            begin
              W:=(FBitmap.Width div PageCount + Integer(FBitmap.Width mod PageCount<>0))*PageCount;
              R.Left:=Pred(PageIndex)*W div PageCount;
              R.Right:=PageIndex*W div PageCount;
              R.Top:=0;
              R.Bottom:=FBitmap.Height;
            end;
            smFitToWidth:
            begin
              H:=(FBitmap.Height div PageCount + Integer(FBitmap.Height mod PageCount<>0))*PageCount;
              R.Left:=0;
              R.Right:=FBitmap.Width;
              R.Top:=Pred(PageIndex)*H div PageCount;
              R.Bottom:=PageIndex*H div PageCount;
            end;
            smOriginalSize,sm1x1,sm50,sm75,sm125,sm150,sm175,sm200,smCustom:
            begin
              GetMD(M,D);
              W:=(M*FBitmap.Width div D div (Right-Left) + Integer(M*FBitmap.Width div D mod (Right-Left)<>0))*(Right-Left);
              H:=(M*FBitmap.Height div D div (Bottom-Top) + Integer(M*FBitmap.Height div D mod (Bottom-Top)<>0))*(Bottom-Top);
              R.Left:=D*(Pred(PageIndex) mod FPageHor)*W div M div FPageHor;
              R.Right:=D*Succ((Pred(PageIndex) mod FPageHor))*W div M div FPageHor;
              R.Top:=D*(Pred(PageIndex) div FPageHor)*H div M div FPageVer;
              R.Bottom:=D*Succ(Pred(PageIndex) div FPageHor)*H div M div FPageVer;
            end;
          end;
          TheCanvas.CopyRect(TheRect,FBitmap.Canvas,R);
        end
        else StretchBitmap(TheCanvas,TheRect,FBitmap,FStretchMode,FAlignHorizontal,FAlignVertical,Target);
      finally
        SelectClipRgn(Handle,RGN);
      end;
    end;
  end
  else inherited;
end;

procedure TCustomBitmapPrintJob.UpdateBitmap;
begin
  if Assigned(FBitmap) then GetBitmap(FBitmap);
  Update;
end;

procedure TCustomBitmapPrintJob.ClearBitmap;
begin
  if Assigned(FBitmap) then
    with FBitmap,Canvas do
    begin
      Brush.Color:=clWhite;
      Brush.Style:=bsSolid;
      FillRect(Rect(0,0,Width,Height));
    end;
end;

end.