aceout.pas

suite component ace report

unit AceOut;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}
uses
  {$IFDEF WIN32}
    windows,
  {$ELSE}
    winprocs,wintypes,
  {$ENDIF}
    Printers, graphics, classes, acesetup, acefile, aceview, aceutil;


type

TAceCanvas = class;

{ TAceDestination }
TAceDestination = (adPrinter, adAceFile, adPreview, adNoWhere);

{ TAceOutput }
  TAceOutput = class(TObject)
  private
    FPrinter: TPrinter;
    FDestination: TAceDestination;
    FAceCanvas: TAceCanvas;
    FHandle: THandle;
    FFileName: String;
    FAceFile: TAceAceFile;
    FAcePrinterSetup: TAcePrinterSetup;
    FPixelsPerInchX, FPixelsPerInchY: Integer;
    FLoadPercent: Single;
    FAceViewer: TAceViewer;
    FDescription: String;
    FCreateFile: Boolean;
  protected
    function GetHandle: THandle;
    procedure SetAcePrinterSetup(ps: TAcePrinterSetup);
    procedure SetDestination(dest: TAceDestination);
  public
    constructor Create;
    destructor Destroy; override;

    procedure FixupPage;
    procedure BeginDoc;
    procedure EndDoc;
    procedure NewPage;
    procedure EndPage;
    procedure StartPage;

    procedure Abort;

    property Destination: TAceDestination read FDestination write SetDestination;
    property AceCanvas: TAceCanvas read FAceCanvas write FAceCanvas;
    property Handle: THandle read GetHandle write FHandle;
    property Printer: TPrinter read FPrinter write FPrinter;
    property FileName: String read FFileName write FFileName;
    property AceFile: TAceAceFile read FAceFile write FAceFile;
    property AceViewer: TAceViewer read FAceViewer write FAceViewer;

    property PixelsPerInchX: Integer read FPixelsPerInchX write FPixelsPerInchX;
    property PixelsPerInchY: Integer read FPixelsPerInchY write FPixelsPerInchY;
    property AcePrinterSetup: TAcePrinterSetup read FAcePrinterSetup write SetAcePrinterSetup;
    property LoadPercent: Single read FLoadPercent write FLoadPercent;
    property Description: String read FDescription write FDescription;
    property CreateFile: Boolean read FCreateFile write FCreateFile;
  end;

{ TAceCanvas }
  TAceCanvas = class(TObject)
  private
    FAceOutput: TAceOutput;
    FFont: TFont;
    FBrush: TBrush;
    FPen: TPen;
    FHandle: THandle;
    FDestination: TAceDestination;
    FPixelsPerInchX, FPixelsPerInchY: Integer;
    FLogFont: TLogFont;
    FLogPen: TLogPen;
    FLogBrush: TLogBrush;
    FSelectFont: THandle;
    FSelectBrush: THandle;
    FSelectPen: THandle;
  protected
    procedure SetFont(f: TFont);
    procedure SetLogFont(lf: TLogFont);
    procedure SetBrush(b: TBrush);
    procedure SetLogBrush(LB: TLogBrush);
    procedure SetPen(p: TPen);
    procedure SetLogPen(LP: TLogPen);

    procedure SetSelectFont(hnd: THandle);
    function GetSelectFont: THandle;
    procedure SetSelectBrush(hnd: THandle);
    function GetSelectBrush: THandle;
    procedure SetSelectPen(hnd: THandle);
    function GetSelectPen: THandle;

    procedure SetHandle( hnd: THandle );
    procedure FontChanged;
    procedure UpdateFont(Sender: TObject);
    procedure UpdatePen(Sender: TObject);
    procedure UpdateBrush(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;


    procedure SetTextAlign(Flags: Word);
    procedure Textout(x,y: Integer; const Text: string);
    procedure MoveTo(x,y: Integer);
    procedure LineTo(x,y: Integer);
    procedure PTextOut(x,y: Integer; Text: PChar; Count: LongInt);
    procedure ExtTextout(x,y: Integer; Options: Word; Rect: TRect; Text: PChar; Count: word);
    procedure TextRect(Rect: TRect; x,y: Integer; const Text: string);
    procedure FillRect(Rect: TRect);
    procedure Rectangle(x1,y1,x2,y2: Integer);
    procedure RoundRect(x1,y1,x2,y2,x3,y3: Integer);
    procedure Ellipse(x1,y1,x2,y2: Integer);
    procedure Draw(x,y: Integer; Graphic: TGraphic);
    procedure StretchDraw(Rect: TRect; Graphic: TGraphic);
    procedure ShadeRect(Rect: TRect; Shade: TAceShadePercent);
    procedure SetFontAngle(Angle: Integer);
    procedure SetBkColor(bkColor: LongInt);
    procedure TextJustify(Rect: TRect; x,y: Integer; const Text: string;
                EndParagraph: Boolean;FullRect: TRect);


    procedure DrawBitmap(X, Y: Integer; Stream: TStream);
    procedure StretchDrawBitmap(Rect: TRect; Stream: TStream);

    property AceOutput: TAceOutput read FAceOutput write FAceoutput;

    property Font: TFont read FFont write SetFont;
    property LogFont: TLogFont read FLogFont write SetLogFont;

    property Brush: TBrush read FBrush write SetBrush;
    property LogBrush: TLogBrush read FLogBrush write SetLogBrush;
    property Pen: TPen read FPen write SetPen;
    property LogPen: TLogPen read FLogPen write SetLogPen;
    property Handle: THandle read FHandle write SetHandle;
    property Destination: TAceDestination read FDestination write FDestination;
    property PixelsPerInchX: Integer read FPixelsPerInchX write FPixelsPerInchX;
    property PixelsPerInchY: Integer read FPixelsPerInchY write FPixelsPerInchY;

    property SelectFont: THandle read GetSelectFont write SetSelectFont;
    property SelectBrush: THandle read GetSelectBrush write SetSelectBrush;
    property SelectPen: THandle read GetSelectPen write SetSelectPen;

{$IFDEF WIN32}
    procedure RtfDraw(Rect: TRect; Stream: TStream; StartPos,EndPos: LongInt; SetDefFont: Boolean);
{$endif}


    procedure DrawCheckBox(Rect: TRect; CheckStyle: TAceCheckStyle; Color: TColor; Thickness: Integer);
    procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure DrawShapeType(dt: TAceDrawType; x1,y1,x2,y2,x3,y3,x4,y4: Integer);

    procedure Polygon(const Points: array of TPoint);
    procedure Polyline(const Points: array of TPoint);
    procedure PolyDrawType(pt: TAcePolyType; const Points: array of TPoint);

    procedure Print3of9Barcode(Left, Top, Width, Height, NarrowWidth, WideWidth: Integer;
           Inches, Vertical: Boolean; BarData: String);
    procedure Print2of5Barcode(Left, Top, Width, Height, NarrowWidth, WideWidth: Integer;
           Inches, Vertical: Boolean; BarData: String);

  end;

TAcePrintOffsetEvent = procedure;

var
  PrintOffsetX, PrintOffsetY: Integer;
  OnPrintOffset: TAcePrintOffsetEvent;




implementation

uses sysutils, dialogs, forms, acetypes, aceimg, acectrl
{$ifdef WIN32}
 , AceRtfP
{$endif}
;

{ TAceOutput }
constructor TAceOutput.Create;
begin
  inherited Create;
  FCreateFile := True;
  FDestination := adPrinter;
  FAceCanvas := TAceCanvas.Create;
  FPrinter := Printers.Printer;
  FHandle := 0;

  FPixelsPerInchX := Screen.PixelsPerInch;
  FPixelsPerInchY := Screen.PixelsPerInch;

  FAcePrinterSetup := TAcePrinterSetup.Create;

  FLoadPercent := 0;
  FFileName := '';
end;

destructor TAceOutput.Destroy;
begin
  if FAceCanvas <> nil then FAceCanvas.Destroy;
  if FAceFile <> nil then FAceFile.Free;
  if FAcePrinterSetup <> nil then FAcePrinterSetup.free;
  inherited Destroy;
end;

procedure TAceOutput.SetDestination(dest: TAceDestination);
begin
  if dest <> FDestination then
  begin
    FDestination := dest;
    FAceCanvas.Destination := FDestination;
  end;
end;

function TAceOutput.GetHandle: THandle;
begin
  if Destination = adPrinter then result := Printer.handle
  else result := FHandle;
end;

procedure TAceOutput.SetAcePrinterSetup(ps: TAcePrinterSetup);
begin
  FAcePrinterSetup.Assign(ps);
end;

procedure TAceOutput.FixupPage;
var
  OffsetX, OffsetY: Integer;
  Res: TPoint;
begin
  if FDestination = adPrinter then
  begin

    PixelsPerInchX := GetDeviceCaps(Handle, LOGPIXELSX);
    PixelsPerInchY := GetDeviceCaps(Handle, LOGPIXELSY);

    SetMapMode(Handle, MM_ANISOTROPIC);
    if Assigned(OnPrintOffset) then
    begin
      OnPrintOffset;
    end;
    Res := AceGetResolution(Handle);
    { Adjust offsets if resolution of printer isn't 300dpi }
    OffsetX := MulDiv(PrintOffsetX, Res.X, 300);
    OffsetY := MulDiv(PrintOffsetY, Res.Y, 300);
    OffsetX := OffsetX - Round(AcePrinterSetup.LeftPrintArea * PixelsPerInchX);
    OffsetY := OffsetY - Round(AcePrinterSetup.TopPrintArea * PixelsPerInchY);
    SetViewportOrgEx(handle,OffsetX,OffsetY, nil);

  end;
end;

procedure TAceOutput.BeginDoc;
begin
  LoadPercent := 0;
  FAceViewer := nil;
  case FDestination of
    adAceFile,adPreview:
    begin
      if AceFile <> nil then
      begin
        AceFile.Free;
        AceFile := nil;
      end;
      AceFile := TAceAceFile.Create;

      if (FDestination = adAceFile) And (FileName <> '') then
      begin
        AceFile.CreateFile := CreateFile;
      end;

      AceFile.FileName := FileName;
      AceFile.Description := Description;

      Handle := 0;

      AcePrinterSetup.SetData;
      AcePrinterSetup.GetData;
      AceFile.AcePrinterSetup := AcePrinterSetup;
      AceFile.PixelsPerInchX := PixelsPerInchX;
      AceFile.PixelsPerInchY := PixelsPerInchY;
      AceFile.BeginDoc;
      if FDestination = adPreview then
      begin
        FAceViewer := TAceViewer.Create(Application);
        FAceViewer.Generating := True;
        FAceViewer.SetAceFile(AceFile);
        FAceViewer.Show;
      end;
    end;
    adPrinter:
    begin
      AcePrinterSetup.SetData;
      AcePrinterSetup.GetData;

      Printer.Title := Description;
      Printer.BeginDoc;
      Handle := Printer.Handle;
      FixupPage;
    end;
    adNoWhere: { do nothing }
  end;
  AceCanvas.AceOutput := self;
  AceCanvas.Handle := Handle;
  AceCanvas.PixelsPerInchX := PixelsPerInchX;
  AceCanvas.PixelsPerInchY := PixelsPerInchY;

  if Destination = adPrinter then
  begin
    { For some odd reason this needed to be done }
    AceCanvas.TextOut(100,400,'');
  end;
end;

procedure TAceOutput.EndDoc;
begin
  LoadPercent := 100;
  AceCanvas.Handle := 0;
  case FDestination of
    adAceFile, adPreview:
    begin
      if AceFile <> nil then
      begin
        AceFile.EndDoc;
        AceFile.PercentDone := 100;
      end;
      { so it doesn't get destroyed by AceOutput }
      if FDestination = adPreview then
      begin
        AceFile := nil;
        FAceViewer.Generating := False;
      end;
    end;
    adPrinter:
    begin
      Printer.EndDoc;
    end;
    adNoWhere: { do nothing }
  end;
end;

procedure TAceOutput.NewPage;
begin
  EndPage;
  StartPage;
end;

procedure TAceOutput.EndPage;
begin
  case FDestination of
    adAceFile, adPreview:
    begin
    end;
    adPrinter:
    begin
  {$IFDEF WIN32}
      windows.EndPage(handle);
  {$ELSE}
      winprocs.EndPage(handle);
  {$ENDIF}
    end;
    adNoWhere: { do nothing }
  end;
end;

procedure TAceOutput.StartPage;
begin
  case FDestination of
    adAceFile, adPreview:
    begin
      { so any new printer settings get set }
      AceFile.AcePrinterSetup := AcePrinterSetup;
      AceFile.NewPage;
      AceFile.PercentDone := LoadPercent;
    end;