acefile.pas

suite component ace report

  result := AceIsPCharEqual(@lb, @LogBrush, SizeOf(LogBrush));
end;

procedure TAceAceFileObject.Write(Str: TStream);
var
  ot: Word;
begin
  case ObjectType of
    aotFont:
    begin
      ot := AceRT_Font;
      Str.Write( ot, SizeOf(ot));
      Str.Write( LogFont, SizeOf(LogFont));
    end;
    aotBrush:
    begin
      ot := AceRT_Brush;
      Str.Write( ot, SizeOf(ot));
      Str.Write( LogBrush, SizeOf(LogBrush));
    end;
    aotPen:
    begin
      ot := AceRT_Pen;
      Str.Write( ot, SizeOf(ot));
      Str.Write( LogPen, SizeOf(LogPen));
    end;
  end;
end;

procedure TAceAceFileObject.Read(Str: TStream);
var
  rt: Word;
begin

  Str.Read(rt, SizeOf(rt));
  case rt of
    AceRT_Font:
    begin
      ObjectType := aotFont;
      Str.Read( LogFont, SizeOf(LogFont));
    end;
    AceRT_Brush:
    begin
      ObjectType := aotBrush;
      Str.Read( LogBrush, SizeOf(LogBrush));
    end;
    AceRT_Pen:
    begin
      ObjectType := aotPen;
      Str.Read( LogPen, SizeOf(LogPen));
    end;
  end;
end;

{ TAceAceFile }
constructor TAceAceFile.Create;
begin
  inherited Create;
  FObjects := TList.Create;
  FLastFont := -1;
  FLastPen := -1;
  FLastBrush := -1;
  FRunning := False;
  FCreateFile := False;

  FCurrFont := -1;
  FCurrPen := -1;
  FCurrBrush := -1;

  FPercentDone := 0;
  AceFileInfo.PixelsPerInchX := Screen.PixelsPerInch;
  AceFileInfo.PixelsPerInchY := Screen.PixelsPerInch;
  FUserStream := TMemoryStream.Create;
end;

destructor TAceAceFile.Destroy;
begin
  Clear;
  if FUserStream <> nil then
  begin
    FUserStream.free;
    FUserStream := nil;
  end;

  inherited Destroy;
end;

{These are to suppress abstratct warning}
    procedure TAceAceFile.LoadAceFile(AceFile: TAceFile); begin end;
    procedure TAceAceFile.LoadPage(AceFile: TAceFile; Page: LongInt); begin end;
    procedure TAceAceFile.LoadPages(AceFile: TAceFile; StartPage, EndPage: LongInt); begin end;


procedure TAceAceFile.Clear;
var
  pos: Integer;
begin
  inherited Clear;
  CurrFont := -1;
  CurrPen := -1;
  CurrBrush := -1;

  LastFont := -1;
  LastPen := -1;
  LastBrush := -1;
  if FObjects <> nil then
  begin
    for pos := 0 to FObjects.Count - 1 do
    begin
      TObject(FObjects.items[pos]).Free;
    end;
    FObjects.Free;
    FObjects := nil;
  end;
  if FUserStream <> nil then TMemoryStream(FUserStream).Clear;
end;

procedure TAceAceFile.SetUserStream(S: TStream);
begin
  TMemoryStream(FUserStream).Clear;
  FUserStream.CopyFrom(S, S.Size);
end;

procedure TAceAceFile.BeginDoc;
var
  pp: TAcePagePosition;
begin
  FPercentDone := 0;
  {
    Changed Version 1.0 - 2.0 RepVersion 1.07 to 1.07a
    A rectangle was added to the TextJustify type for an extra parameter
  }
  {
    Changed Version 3.0 RepVersion 1.08 to 1.09
    CollatedCopies was added to the AceFilePrinterInfo structure
   }
  { Changed Version 3.0 - 4.0 Rep > 1.09b
    Printer Information is totaly different.
    Only settings other than default are saved

    Change Strings to handle long strings
  }

  with AceFileHeader do
  begin
    StrLCopy(Name, 'ACE',3);
    Key := 101071;
    Version := 4.0;
    HeaderLen := 0
  end;



  if Stream <> nil then Clear;
  if FObjects <> nil then Clear;
  Stream := TAceStream.Create;
  FObjects := TList.Create;
  FAceStartPrinterSetup := TAcePrinterSetup.Create;
  FAceStartPrinterSetup.Assign(AcePrinterSetup);

  { start off first page }
  pp := TAcePagePosition.Create;
  pp.Pos := 0;
  pages.Add(pp);

  AcePrinterSetup.WriteToAceFile(Self);

  WriteType(AceRT_StartPage);

  Running := True;
end;

procedure TAceAceFile.EndDoc;
var
  fs: TFileStream;
  Spot: LongInt;
  pos: LongInt;
  len: LongInt;
begin
  WriteType(AceRT_EndPage);

  AceFileInfo.Pages := Pages.Count;
  AceFileInfo.objects := objects.Count;

  for pos := 0 to SizeOf(AceFileHeader.Description) -1 do
       AceFileHeader.Description[pos] := #0;

  {$ifdef WIN32}
  StrPLCopy(AceFileHeader.Description, PChar(Description), Length(Description));
  {$else}
  StrPLCopy(AceFileHeader.Description, Description[1], Length(Description));
  {$endif}

  if CreateFile then
  begin

    fs := TFileStream.Create(FileName, fmCreate);


    fs.Write(AceFileHeader, SizeOf(AceFileHeader));
    fs.Write(AceFileInfo, SizeOf(AceFileInfo));
{    fs.Write(AceFilePrinterInfo, SizeOf(AceFilePrinterInfo));}
    FAceStartPrinterSetup.WriteToStream(fs);
    FAceStartPrinterSetup.Free;

    Len := FUserStream.Size;;
    fs.Write(Len, SizeOf(Len));
    FUserStream.Position := 0;
    fs.CopyFrom(FUserStream, FUserStream.Size);

    for pos := 0 to pages.count - 1 do
    begin
      Spot := TAcePagePosition(pages.items(pos)).Pos;
      fs.Write(Spot, SizeOf(Spot));
    end;

    for pos := 0 to objects.count - 1 do TAceAceFileObject(objects.items[pos]).Write(fs);

    AceFileHeader.HeaderLen := fs.Size;
    fs.Position := 0;
    fs.Write(AceFileHeader, SizeOf(AceFileHeader));
    fs.Position := fs.Size;

    Stream.Position := 0;
    fs.CopyFrom(Stream, Stream.Size);

    fs.Free;
  end else
  begin
    AcePrinterSetup.Assign(FAceStartPrinterSetup);
    FAceStartPrinterSetup.Free;
  end;
  FAceStartPrinterSetup := nil;

  Running := False;
  FPercentDone := 100;
end;

function TAceAceFile.GetPagePrinterInfo(APS: TAcePrinterSetup; Page: LongInt): Boolean;
var
  pp: TAcePagePosition;
  RecType: Word;
  SavePos: LongInt;
  PI: TAceFilePrinterInfo;
begin
  Result := False;
  if (Pages.Count > 0) And (Not Running Or (Pages.Count > 1)) then
  begin
    SavePos := Stream.Position;

    if Page < 1 then Page := 1;
    if Running And (Page > (Pages.Count - 1)) then Page := Pages.Count - 1;
    if Page > Pages.Count then Page := Pages.Count - 1;
    if Page < 1 then Page := 1;

    pp := pages.items(page - 1);
    Stream.Position := pp.Pos;


    ReadType(RecType);
    if RecType = AceRT_PrinterInfo then
    begin
      ReadPrinterInfo(PI);
      APS.SetPrintInfo(PI);
      Result := True;
    end else if RecType = AceRT_NewPrinterInfo then
    begin
      Result := APS.ReadFromAceFile(Self);
    end;

    Stream.Position := SavePos;
  end else APS.Assign(AcePrinterSetup);
end;

procedure TAceAceFile.NewPage;
var
  pp: TAcePagePosition;
begin
  WriteType(AceRT_EndPage);
  pp := TAcePagePosition.Create;
  pp.Pos := Stream.Position;
  pages.Add(pp);

  AcePrinterSetup.WriteToAceFile(self);

  WriteType(AceRT_StartPage);
  { set the last selected objects }
  if CurrFont <> -1 then
  begin
    WriteType(AceRT_SelectObject);
    WriteSmallInt(CurrFont);
  end;
  if CurrPen <> -1 then
  begin
    WriteType(AceRT_SelectObject);
    WriteSmallInt(CurrPen);
  end;
  if CurrBrush <> -1 then
  begin
    WriteType(AceRT_SelectObject);
    WriteSmallInt(CurrBrush);
  end;
end;

procedure TAceAceFile.SetFont(font: TFont);
var
  logfont: TLogFont;
begin
  AceGetObject(font.handle, SizeOf(TLogFont), Addr(logfont));
  SetLogFont(Font, LogFont);
end;

procedure TAceAceFile.SetLogFont(Font: TFont; LogFont: TLogFont);
var
  pos, spot: Integer;
  lf: TAceLogFont;
  obj: TAceAceFileObject;
  nm: String;
begin
  spot := -1;
  pos := 0;

  lf.Color := font.color;
  lf.Size := font.size;

  lf.Italic := LogFont.lfItalic;
  lf.Underline := Logfont.lfUnderline;
  lf.StrikeOut := Logfont.lfStrikeOut;
  lf.Escapement := logfont.lfEscapement;
  lf.Weight := logfont.lfWeight;
  lf.CharSet := logfont.lfCharset;
  lf.OutPrecision := logfont.lfOutPrecision;
  lf.ClipPrecision := logfont.lfClipPrecision;
  lf.Quality := Logfont.lfQuality;
  lf.PitchAndFamily := logfont.lfPitchAndFamily;

  nm := font.name;
  StrLCopy(lf.Name, AceStrtoPChar(nm), lf_FaceSize);

  while pos < Objects.Count do
  begin
    obj := Objects.items[pos];
    if obj.objecttype = aotFont then
    begin
      if obj.FontSame( lf ) then
      begin
        spot := pos;
        pos := Objects.Count;
      end;
    end;
    Inc(pos);
  end;
  if spot = -1 then
  begin
    obj := TAceAceFileObject.Create;
    obj.objecttype := aotFont;
    Obj.LogFont := lf;
    Objects.Add(obj);
    Spot := Objects.Count - 1;
  end;

  WriteType(AceRT_SelectObject);
  WriteSmallInt(Spot);
  CurrFont := Spot;
end;
procedure TAceAceFile.SetPen(pen: TPen);
var
  pos, spot: Integer;
  lp: TAceLogPen;
  obj: TAceAceFileObject;
begin
  spot := -1;
  pos := 0;
  lp.Color := pen.color;
  lp.style := pen.style;
  lp.width := pen.width;
  lp.mode := pen.mode;
  while pos < Objects.Count do
  begin
    obj := Objects.items[pos];
    if obj.objecttype = aotPen then
    begin
      if obj.PenSame( lp) then
      begin
        spot := pos;
        pos := Objects.Count;
      end;
    end;
    Inc(pos);
  end;
  if spot = -1 then
  begin
    obj := TAceAceFileObject.Create;
    obj.objecttype := aotPen;
    obj.logpen := lp;
    Objects.Add(obj);
    Spot := Objects.Count - 1;
  end;

  WriteType(AceRT_SelectObject);
  WriteSmallInt(Spot);
  CurrPen := Spot;
end;

procedure TAceAceFile.SetBrush(brush: TBrush);
var
  pos, spot: Integer;
  lb: TAceLogBrush;
  obj: TAceAceFileObject;
begin
  spot := -1;
  pos := 0;
  lb.Color := Brush.Color;
  lb.Style := Brush.Style;
  while pos < Objects.Count do
  begin
    obj := Objects.items[pos];
    if obj.objecttype = aotBrush then
    begin
      if obj.BrushSame( lb) then
      begin
        spot := pos;
        pos := Objects.Count;
      end;
    end;
    Inc(pos);
  end;
  if spot = -1 then
  begin
    obj := TAceAceFileObject.Create;
    obj.objecttype := aotBrush;
    obj.LogBrush := lb;
    Objects.Add(obj);
    Spot := Objects.Count - 1;
  end;

  WriteType(AceRT_SelectObject);
  WriteSmallInt(Spot);
  CurrBrush := Spot;
end;


procedure TAceAceFile.SetTextAlign(flags: Word);
begin
  WriteType(AceRT_SetTextAlign);
  WriteWord(flags);
end;
procedure TAceAceFile.Textout(x,y: Integer; const Text: string);
begin
  WriteType(AceRT_TextOut);
  WriteSmallInt(x);
  WriteSmallInt(y);
  WriteString(Text);
end;
procedure TAceAceFile.MoveTo(x,y: Integer);
begin
  WriteType(AceRT_MoveTo);
  WriteSmallInt(x);
  WriteSmallInt(y);
end;
procedure TAceAceFile.LineTo(x,y: Integer);
begin
  WriteType(AceRT_LineTo);
  WriteSmallInt(x);
  WriteSmallInt(y);
end;
procedure TAceAceFile.PTextout(x,y: Integer; Text: PChar; count: LongInt);
begin
  WriteType(AceRT_PTextOut);
  WriteSmallInt(x);
  WriteSmallInt(y);
  WritePChar(Text, Count);
end;
procedure TAceAceFile.ExtTextout(x,y: Integer; Options: Word; Rect: TRect; Text: PChar; count: word);
begin
  WriteType(AceRT_ExtTextOut);
  WriteSmallInt(x);
  WriteSmallInt(y);
  WriteWord(Options);
  WriteRect(Rect);
  WritePChar(Text, Count);
end;