acefile.pas

suite component ace report

unit AceFile;

{ ----------------------------------------------------------------
  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}
  SysUtils, Classes, Graphics, forms, acetypes, aceutil, acesetup, acestr;

{$IFDEF WIN32}
  {$WARNINGS OFF}
{$ENDIF}

type

TAceFile = class;

{ TAceFiler }
  TAceFiler = class(TObject)
  private
    FAceFile: TAceFile;
  protected
    procedure SetAceFile(AF: TAceFile); virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    property AceFile: TAceFile read FAceFile write SetAceFile;

    procedure LoadFromStream(Stream: TStream); virtual;
    procedure LoadFromFile(FileName: String); virtual;
    procedure SaveToFile(FileName: String); virtual;
    procedure SaveToStream( Stream: TStream); virtual;

    procedure Send(AF: TAceFile); virtual;
    procedure SendPage(AF: TAceFile; Page: LongInt); virtual;
    procedure SendPages(AF: TAceFile; StartPage, EndPage: LongInt); virtual;
  end;

{ TAceFile }
  TAceFile = class(TPersistent)
  private
    FStream: TAceStream;
    FPages: TAceList;
    FAcePrinterSetup: TAcePrinterSetup;
    FHorzScale, FVertScale, FOrgX, FOrgY: Integer;
    FSetOrigin: Boolean;
    FIgnorePrinterSettings: Boolean;
  protected
    procedure SetAcePrinterSetup(ps: TAcePrinterSetup);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property Stream: TAceStream read FStream write FStream;
    procedure LoadAceFile(AceFile: TAceFile); virtual; abstract;
    procedure LoadPage(AceFile: TAceFile; Page: LongInt); virtual; abstract;
    procedure LoadPages(AceFile: TAceFile; StartPage, EndPage: LongInt); virtual; abstract;
    procedure LoadFromFile(FileName: String); virtual; abstract;
    procedure LoadFromStream(LoadStream: TStream); virtual; abstract;
    procedure Send(AceFile: TAceFile); virtual; abstract;
    procedure SendPage(AceFile: TAceFile; Page: LongInt); virtual; abstract;
    procedure SendPages(AceFile: TAceFile; StartPage, EndPage: LongInt); virtual; abstract;
    procedure SaveToFile(FileName: String); virtual; abstract;
    procedure SaveToStream(SaveStream: TStream); virtual; abstract;
    procedure PlayPage(DC: THandle; Page: LongInt); virtual; abstract;
{
    procedure Scale(DC: THandle); virtual; abstract;
 }
    procedure Clear; virtual;
    property Pages: TAceList read FPages write FPages;

    property AcePrinterSetup: TAcePrinterSetup read FAcePrinterSetup write SetAcePrinterSetup;

    property HorzScale: Integer read FHorzScale write FHorzScale;
    property VertScale: Integer read FVertScale write FVertScale;
    property OrgX: Integer read FOrgX write FOrgX;
    property OrgY: Integer read FOrgY write FOrgY;
    property SetOrigin: Boolean read FSetOrigin write FSetOrigin;
    property IgnorePrinterSettings: Boolean read FIgnorePrinterSettings write FIgnorePrinterSettings;
  end;

{ TAcePrinter }
  TAcePrinter = class(TAceFile)
  private
    FAbortPrinting: Boolean;
    FStopPrinting: Boolean;
    FOnStatus: TNotifyEvent;
    FPageNumber: Integer;
  protected
  public
    constructor Create; override;
    destructor Destroy; override;
    property AbortPrinting: Boolean read FAbortPrinting write FAbortPrinting;
    property StopPrinting: Boolean read FStopPrinting write FStopPrinting;

    procedure LoadPage(AceFile: TAceFile; Page: LongInt); override;
    procedure LoadPages(AceFile: TAceFile; StartPage, EndPage: LongInt); override;
    procedure LoadFromFile(FileName: String); override;
    procedure LoadFromStream(LoadStream: TStream); override;


    procedure LoadAceFile(AceFile: TAceFile); override;
    procedure Send(AceFile: TAceFile); override;
    procedure SendPage(AceFile: TAceFile; Page: LongInt); override;
    procedure SendPages(AceFile: TAceFile; StartPage, EndPage: LongInt); override;
    procedure SaveToFile(FileName: String); override;
    procedure SaveToStream(SaveStream: TStream); override;
    procedure PlayPage(DC: THandle; Page: LongInt); override;
{    procedure Scale(DC: THandle); override;}

    property OnStatus: TNotifyEvent read FOnStatus write FOnStatus;
    property PageNumber: Integer read FPageNumber write FPageNumber;
  end;

{ TAceDeviceContext }
  TAceDeviceContext = class(TAceFile)
  private
    FDC: THandle;
  protected
    procedure SetDC( DevContext: THandle);
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure LoadPage(AceFile: TAceFile; Page: LongInt); override;
    procedure LoadPages(AceFile: TAceFile; StartPage, EndPage: LongInt); override;
    procedure LoadFromFile(FileName: String); override;
    procedure LoadFromStream(LoadStream: TStream); override;

    procedure LoadAceFile(AceFile: TAceFile); override;
    procedure Send(AceFile: TAceFile); override;
    procedure SendPage(AceFile: TAceFile; Page: LongInt); override;
    procedure SendPages(AceFile: TAceFile; StartPage, EndPage: LongInt); override;
    procedure SaveToFile(FileName: String); override;
    procedure SaveToStream(SaveStream: TStream); override;
    procedure PlayPage(DC: THandle; Page: LongInt); override;


    property DC: THandle read FDC write SetDC;
  end;

{ TAcePagePosition }
  TAcePagePosition = class(TObject)
  public
    Pos: Longint;
  end;

{ TAceAceFileObjectTypes }
  TAceAceFileObjectTypes = (aotNone, aotBrush, aotFont, aotPen);

{ TAceAceFileObject }
  TAceAceFileObject = class(TObject)
  private
  protected
  public
    ObjectType: TAceAceFileObjectTypes;
    Pen: TPen;
    Brush: TBrush;
    Font: TFont;
    SelectFont: THandle;
    SelectBrush: THandle;
    SelectPen: THandle;
    LogPen: TAceLogPen;
    LogBrush: TAceLogBrush;
    LogFont: TAceLogFont;
    constructor Create; virtual;
    destructor Destroy; override;

    procedure CreateObject(PixelsPerInchY: Integer);
    procedure DeleteObject;
    function FontSame(lf: TAceLogFont): Boolean;
    function PenSame(lp: TAceLogPen): Boolean;
    function BrushSame(lb: TAceLogBrush): Boolean;
    procedure Write(Str: TStream);
    procedure Read(Str: TStream);
  end;

{ TAceAceFile }
  TAceAceFile = class(TAceFile)
  private
    FObjects: TList;
    FFileName: String;
    FLastFont, FLastPen, FLastBrush: Integer;
    FCurrFont, FCurrPen, FCurrBrush: Integer;
    FRunning: Boolean;
    FPercentDone: Single;
    FDescription: String;
    FUserStream: TStream;
    FCreateFile: Boolean;
    FAceStartPrinterSetup: TAcePrinterSetup;
  protected
    function GetPageWidth: Integer;
    function GetPageHeight: Integer;
    function GetPixelsPerInchX: Integer;
    procedure SetPixelsPerInchX( ppi: Integer );
    function GetPixelsPerInchY: Integer;
    procedure SetPixelsPerInchY( ppi: Integer );

    procedure SetUserStream(S: TStream);
  public
    AceFileHeader: TAceFileHeader;
    AceFileInfo: TAceFileInfo;
    AceFilePrinterInfo: TAceFilePrinterInfo;

    constructor Create; override;
    destructor Destroy; override;

    property PercentDone: Single read FPercentDone write FPercentDone;

    property PageWidth: Integer read GetPageWidth;
    property PageHeight: Integer read GetPageHeight;
    property PixelsPerInchX: Integer read GetPixelsPerInchX write SetPixelsPerInchX;
    property PixelsPerInchY: Integer read GetPixelsPerInchY write SetPixelsPerInchY;

    property Description: String read FDescription write FDescription;
    property UserStream: TStream read FUserStream write SetUserStream;
    procedure Clear; override;
    property Running: Boolean read FRunning write FRunning;
    property CreateFile: Boolean read FCreateFile write FCreateFile;

    function GetPagePrinterInfo(APS: TAcePrinterSetup; Page: LongInt): Boolean;

    procedure BeginDoc;
    procedure EndDoc;
    procedure NewPage;

    procedure SetFont(font: TFont);
    procedure SetLogFont(Font: TFont; LogFont: TLogFont);
    procedure SetPen(pen: TPen);
    procedure SetBrush(brush: TBrush);


    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 DrawBitmap(X, Y: Integer; Stream: TStream);
    procedure StretchDrawBitmap(Rect: TRect; Stream: TStream);

    procedure ShadeRect(Rect: TRect; Shade: TAceShadePercent);
    procedure SetBkColor(bkColor: LongInt);
    procedure TextJustify(Rect: TRect; x,y: Integer; const Text: string;
         EndParagraph: Boolean; FullRect: TRect);
    {$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 DrawShapeType(dt: TAceDrawType; x1,y1,x2,y2,x3,y3,x4,y4: Integer);
    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);



    procedure WritePrinterInfo(pi: TAceFilePrinterInfo);
    procedure WriteType(RecType: Word);
    procedure WriteRect(Rect: TRect);
    procedure WriteWord(W: Word);
    procedure WriteSmallInt(I: SmallInt);
    procedure WriteLongInt(LI: LongInt);
    procedure WriteString(S: String);
    procedure WritePChar(S: PChar; Len: LongInt);
    procedure WriteStream(S: TStream);
    procedure WriteBoolean(Value: Boolean);

    procedure ReadPrinterInfo(var pi: TAceFilePrinterInfo);
    procedure ReadType(var RecType: Word);
    procedure ReadRect(var Rect: TRect);
    procedure ReadWord(var W: Word);
    procedure ReadSmallInt(var I: SmallInt);
    procedure ReadLongInt(var LI: LongInt);
    procedure ReadString(var S: String);
    procedure ReadPChar(var S: PChar; Len: LongInt);
    procedure ReadStream(S: TStream);
    procedure ReadBoolean(var Value: Boolean);

    procedure LoadAceFile(AceFile: TAceFile); override;
    procedure LoadPage(AceFile: TAceFile; Page: LongInt); override;
    procedure LoadPages(AceFile: TAceFile; StartPage, EndPage: LongInt); override;

    procedure Send(AceFile: TAceFile); override;
    procedure SendPage(AceFile: TAceFile; Page: LongInt); override;
    procedure SendPages(AceFile: TAceFile; StartPage, EndPage: LongInt); override;

    procedure SaveToFile(FileName: String); override;
    procedure SaveToStream(SaveStream: TStream); override;

    procedure LoadFromFile(FileName: String); override;
    procedure LoadFromStream(LoadStream: TStream); override;

{    procedure Scale(DC: THandle); override;}

    procedure PlayPage(DC: THandle; Page: LongInt); override;

    procedure PlayRecord(RecType: Integer; DC: THandle);

    property Objects: TList read FObjects write FObjects;
    property FileName: String read FFileName write FFileName;

    property LastFont: Integer read FLastFont write FLastFont;
    property LastPen: Integer read FLastPen write FLastPen;
    property LastBrush: Integer read FLastBrush write FLastBrush;

    property CurrFont: Integer read FCurrFont write FCurrFont;
    property CurrPen: Integer read FCurrPen write FCurrPen;
    property CurrBrush: Integer read FCurrBrush write FCurrBrush;
  end;



TAceRecordPrintEvent = procedure (Handle: THandle; AceFile: TAceAceFile);
procedure AceAddRecordType(const RecordType: SmallInt; PrintEvent: TAceRecordPrintEvent);

var
  DuplexNewJob: Boolean;


implementation

uses dialogs, aceout, aceimg, acectrl
{$ifdef WIN32}
 , AceRtfP
{$endif}
;

type
  TAceRecType = class(TObject)
  public
    RecordType: SmallInt;
    RecordPrintEvent: TAceRecordPrintEvent;
  end;

var
  RecordTypeList: TList;


{ TAceFiler }
constructor TAceFiler.Create;
begin
  inherited Create;

end;

destructor TAceFiler.Destroy;
begin
  if FAceFile <> nil then FAceFile.Free;
  inherited destroy;
end;

procedure TAceFiler.SetAceFile(AF: TAceFile);
begin
  if (FAceFile <> nil) And (AF <> nil) then FAceFile.Free;
  FAceFile := AF;
end;

procedure TAceFiler.SendPages(AF: TAceFile; StartPage, EndPage: LongInt);
begin
  if AceFile <> nil then Acefile.SendPages(AF, StartPage, EndPage)
end;

procedure TAceFiler.SendPage(AF: TAceFile; page: LongInt);
begin
  if AceFile <> nil then Acefile.SendPage(AF, page)
end;

procedure TAceFiler.Send(AF: TAceFile);
begin
  if AceFile <> nil then AceFile.Send(AF);
end;

procedure TAceFiler.LoadFromFile(FileName: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(Stream);
  finally
    Stream.free;
  end;
end;
procedure TAceFiler.LoadFromStream(Stream: TStream);
var
  ah: TAceFileHeader;
  lGood: Boolean;
begin
  Stream.Read(ah, SizeOf(ah));
  lGood := ah.Key = 101071;

{ will free up old one in set method }
  if lGood then
  begin
    AceFile := TAceAceFile.Create;
    try
      Stream.Position := 0;
      AceFile.LoadFromStream(Stream);
    except
      AceFile := nil;
    end;
  end;
end;
procedure TAceFiler.SaveToFile(FileName: String);
begin
  if AceFile <> nil then AceFile.SaveToFile(FileName);
end;
procedure TAceFiler.SaveToStream(Stream: TStream);
begin
  if AceFile <> nil then AceFile.SaveToStream(Stream);
end;

{ TAceFile }
constructor TAceFile.Create;
begin
  inherited Create;
  FPages := TAceList.Create;
  FAcePrinterSetup := TAcePrinterSetup.Create;

  FHorzScale := 100;
  FVertScale := 100;
  FOrgX := 0;
  FOrgY := 0;
  FSetOrigin := False;
  FIgnorePrinterSettings := False;
end;

destructor TAceFile.Destroy;
begin
  Clear;
  if FPages <> nil then
  begin
    FPages.Free;
    FPages := nil;
  end;
  if FAcePrinterSetup <> nil then FAcePrinterSetup.Free;
  inherited Destroy;
end;

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

procedure TAceFile.Clear;
var
  pos: Integer;
begin
  if FStream <> nil then
  begin
    FStream.Free;
    FStream := nil;
  end;
  if FPages <> nil then
  begin
    if FPages.Count > 0 then
      for pos := 0 to FPages.Count - 1 do
        TObject(FPages.items(pos)).Free;
    FPages.Clear;
  end;
end;