acemerge.pas

suite component ace report

unit AceMerge;

interface

uses classes, Acefile, Aceutil, AceStr, SysUtils, AceTypes, AceSetup;

type

  TAceMerge = class(TObject)
  private
    FStream: TAceStream;
    FPages: TAceList;

    FObjects, FNewObjects: TList;
    FDescription: String;
    FUserStream: TMemoryStream;

    FAcePrinterSetup: TAcePrinterSetup;

    FAceFileHeader: TAceFileHeader;
    FAceFileInfo: TAceFileInfo;
{    FAceFilePrinterInfo: TAceFilePrinterInfo;}
    FAceFilesAdded: LongInt;
    FPageStart: LongInt;

    procedure GetPrinterSetup(LoadStream: TStream; afh: TAceFileHeader);
    procedure GetUserStream(LoadStream: TStream);
    procedure GetPages(LoadStream: TStream;afi: TAceFileInfo);
    procedure GetObjects(LoadStream: TStream; afi: TAceFileInfo);
    procedure GetPageData(LoadStream: TStream; afh: TAceFileHeader);
    procedure ChangeObjects(RecType: Word; afh: TAceFileHeader);
  protected
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Clear;
    procedure LoadFromStream(LoadStream: TStream);
    procedure LoadFromFile(FileName: String);
    procedure SaveToFile(FileName: String);
    procedure SaveToStream(SaveStream: TStream);
  end;

  TAceMergeObject = class(TObject)
  private
    FObjectType: TAceAceFileObjectTypes;
    FLogPen: TAceLogPen;
    FLogBrush: TAceLogBrush;
    FLogFont: TAceLogFont;
    FUseObject: LongInt;
  protected
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Assign(Source: TObject);
    function IsEqual(Source: TObject): Boolean;
    function FontSame(lf: TAceLogFont): boolean;
    function PenSame(lp: TAceLogPen): boolean;
    function BrushSame(lb: TAceLogBrush): boolean;
    procedure Write(Stream: TStream);
    procedure Read(Stream: TStream);
  end;

implementation


constructor TAceMerge.Create;
begin
  FObjects := TList.Create;
  FNewObjects := TList.Create;
  FUserStream := TMemoryStream.Create;
  FPages := TAceList.Create;
  FAcePrinterSetup := TAcePrinterSetup.Create;
  FStream := TAceStream.Create;
end;
destructor TAceMerge.Destroy;
begin
  Clear;
  if FStream <> nil then FStream.Free;
  if FUserStream <> nil then FUserStream.Free;
  if FPages <> nil then FPages.Free;
  if FAcePrinterSetup <> nil then FAcePrinterSetup.Free;
  if FObjects <> nil then FObjects.Free;
  if FNewObjects <> nil then FNewObjects.Free;
  inherited Destroy;
end;
procedure TAceMerge.Clear;
var
  Spot: Integer;
begin
  FAceFilesAdded := 0;
  if FStream <> nil then FStream.Clear;
  if FPages <> nil then
  begin
    for Spot := 0 to FPages.Count - 1 do TObject(FPages.items(Spot)).Free;
    FPages.Clear;
  end;
  if FObjects <> nil then
  begin
    for Spot := 0 to FObjects.Count - 1 do TObject(FObjects.Items[Spot]).Free;
    FObjects.Clear;
  end;
  if FNewObjects <> nil then
  begin
    for Spot := 0 to FNewObjects.Count - 1 do TObject(FNewObjects.Items[Spot]).Free;
    FNewObjects.Clear;
  end;
  if FUserStream <> nil then TMemoryStream(FUserStream).Clear;
end;

procedure TAceMerge.GetPrinterSetup(LoadStream: TStream; afh: TAceFileHeader);
var
  aps: TAcePrinterSetup;
  afpi: TAceFilePrinterInfo;
  rc: Word;
begin
  if FAceFilesAdded = 1 then aps := FAcePrinterSetup
  else aps := TAcePrinterSetup.Create;

  if afh.Version < 3.0 then
  begin
    LoadStream.Read(afpi, SizeOf(afpi)- SizeOf(afpi.CollatedCopies));
    afpi.CollatedCopies := True;
    aps.SetPrintInfo( afpi );
  end else if afh.Version < 4.0 then
  begin
    LoadStream.Read(afpi, SizeOf(TAceFilePrinterInfo));
    aps.SetPrintInfo( afpi);
  end else
  begin
    LoadStream.Read(rc, SizeOf(rc));
    aps.ReadFromStream(LoadStream);
  end;

  if FAceFilesAdded > 1 then aps.Free;
end;
procedure TAceMerge.GetUserStream(LoadStream: TStream);
var
  Len: LongInt;
begin
  if FAceFilesAdded = 1 then
  begin
    TMemoryStream(FUserStream).Clear;
    LoadStream.Read(Len, SizeOf(Len));
    if Len > 0 then FUserStream.CopyFrom(LoadStream, Len);
  end else
  begin
    LoadStream.Read(Len, SizeOf(Len));
    if Len > 0 then LoadStream.Position := LoadStream.Position + Len;
  end;
end;
procedure TAceMerge.GetPages(LoadStream: TStream;afi: TAceFileInfo);
var
  PageDataStart, PagePos, PageSpot: LongInt;
  pp: TAcePagePosition;
begin
  FPageStart := FPages.Count;
  PageDataStart := FStream.Size;
  for PageSpot := 0 to afi.Pages - 1 do
  begin
    pp := TAcePagePosition.Create;
    LoadStream.Read(PagePos, SizeOf(PagePos));
    pp.Pos := PagePos + PageDataStart;
    FPages.Add(pp);
  end;
end;
procedure TAceMerge.GetObjects(LoadStream: TStream; afi: TAceFileInfo);
var
  rc: Word;
  obj, newobj: TAceMergeObject;
  Spot, OldSpot: Integer;
begin
  if FNewObjects <> nil then
  begin
    for Spot := 0 to FNewObjects.Count - 1 do TObject(FNewObjects.Items[Spot]).Free;
    FNewObjects.Clear;
  end;
  for Spot := 0 to afi.Objects - 1 do
  begin
    LoadStream.Read(rc, SizeOf(rc));
    obj := TAceMergeObject.Create;
    case rc of
      AceRT_Font:
      begin
        obj.FObjectType := aotFont;
        LoadStream.Read(obj.FLogFont, SizeOf(TAceLogFont));
      end;
      AceRT_Pen:
      begin
        obj.FObjectType := aotPen;
        LoadStream.Read(obj.FLogPen, SizeOf(TAceLogPen));
      end;
      AceRT_Brush:
      begin
        obj.FObjectType := aotBrush;
        LoadStream.Read(obj.FLogBrush, SizeOf(TAceLogBrush));
      end;
    end;
    FNewObjects.Add(obj);
  end;
  for Spot := 0 to FNewObjects.Count - 1 do
  begin
    obj := FNewObjects.Items[Spot];
    OldSpot := 0;
    while OldSpot < FObjects.Count do
    begin
      if obj.IsEqual(FObjects.Items[OldSpot]) then
      begin
        obj.FUseObject := OldSpot;
        OldSpot := FObjects.Count;
      end else Inc(OldSpot);
    end;
    if obj.FUseObject = -1 then
    begin
      newobj := TAceMergeObject.Create;
      newobj.Assign(obj);
      FObjects.Add(newobj);
      obj.FUseObject := FObjects.Count - 1;
    end;
  end;
end;

procedure TAceMerge.GetPageData(LoadStream: TStream; afh: TAceFileHeader);
var
  pp: TAcePagePosition;
  RecType: Word;
  StreamSize: LongInt;
  Spot: LongInt;
begin
  FStream.Seek(0,soFromEnd);
  FStream.CopyFrom(LoadStream, LoadStream.Size - LoadStream.Position);

  StreamSize := FStream.Size;
  for Spot := FPageStart to FPages.Count - 1 do
  begin
    pp := FPages.Items(Spot);
    FStream.Position := pp.Pos;

    FStream.Read(RecType, SizeOf(RecType));
    while (RecType <> AceRT_EndPage) And (FStream.Position < StreamSize) do
    begin
      ChangeObjects(RecType, afh);
      FStream.Read(RecType, SizeOf(RecType));
    end;
  end;
end;
procedure TAceMerge.ChangeObjects(RecType: Word; afh: TAceFileHeader);
var
  Spot: SmallInt;
  obj: TAceMergeObject;
  Count :LongInt;
  procedure StreamMove(Len: LongInt);
  begin
    FStream.Position := FStream.Position + Len;
  end;
  procedure ReadRect;
  begin
    StreamMove(SizeOf(SmallInt) * 4);
  end;
  procedure ReadWord;
  begin
    StreamMove(SizeOf(Word));
  end;
  function ReadSmallInt: SmallInt;
  begin
    FStream.Read(Result, SizeOf(Result));
  end;
  function ReadLongInt: LongInt;
  begin
    FStream.Read(Result, SizeOf(Result));
  end;
  procedure ReadString;
  var
    Len: SmallInt;
    LongLen: LongInt;
  begin
    if afh.Version < 4.0 then
    begin
      FStream.Read(Len, SizeOf(Len));
      LongLen := Len;
    end else
    begin
      FStream.Read(LongLen, SizeOf(LongLen));
    end;
    StreamMove(LongLen);
  end;
  procedure ReadStream;
  var
    Len: LongInt;
  begin
    FStream.Read(Len, SizeOf(Len));
    StreamMove(Len);
  end;
  procedure ReadBoolean;
  begin
    StreamMove(SizeOf(Boolean));
  end;


begin
  case RecType of
    AceRT_SelectObject:
    begin
      Spot := ReadSmallInt;
      obj := TAceMergeObject(FNewObjects.Items[Spot]);
      StreamMove(-SizeOf(SmallInt));
      FStream.Write(obj.FUseObject, SizeOf(SmallInt));
    end;
    AceRT_StartPage, AceRT_EndPage:;
    AceRT_SetTextAlign: ReadWord;
    AceRT_TextOut:
    begin
      ReadSmallInt;
      ReadSmallInt;
      ReadString;
    end;
    AceRT_MoveTo, AceRT_LineTo:
    begin
      ReadSmallInt;
      ReadSmallInt;
    end;
    AceRT_PTextOut:
    begin
      ReadSmallInt;
      ReadSmallInt;
      Count := ReadLongInt;
      StreamMove(Count);