acetext.pas

suite component ace report

unit AceText;

interface
{$I ace.inc}
implementation


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

destructor TAceAceFile.Destroy;
begin
  Clear;
  inherited Destroy;
end;

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

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

procedure TAceAceFile.ReadPrinterInfo(var pi: TAceFilePrinterInfo);
begin
  Stream.Read(pi, SizeOf(pi));
end;
procedure TAceAceFile.ReadType(var RecType: Word);
begin
  Stream.Read(RecType, SizeOf(RecType));
end;
procedure TAceAceFile.ReadRect(var Rect: TRect);
var
  value: SmallInt;
begin
  ReadSmallInt(value);
  Rect.left := value;
  ReadSmallInt(value);
  Rect.top := value;
  ReadSmallInt(value);
  Rect.right := value;
  ReadSmallInt(value);
  Rect.bottom := value;
end;
procedure TAceAceFile.ReadWord(var W: Word);
begin
  Stream.Read(W, SizeOf(W));
end;
procedure TAceAceFile.ReadSmallInt(var I: SmallInt);
begin
  Stream.Read(I, SizeOf(I));
end;
procedure TAceAceFile.ReadLongInt(var LI: LongInt);
begin
  Stream.Read(LI, SizeOf(LI));
end;
procedure TAceAceFile.ReadString(var S: String);
var
  Len: SmallInt;
  LongLen: LongInt;
  {$ifndef WIN32}
  MStream: TMemoryStream;
  BLen: Byte;
  {$endif}
begin
  S := '';
  if AceFileHeader.Version < 4.0 then
  begin
    Stream.Read(Len, SizeOf(Len));
    LongLen := Len;
  end else
  begin
    Stream.Read(LongLen, SizeOf(LongLen));
  end;
  if LongLen > 0 then
  begin
    {$ifdef WIN32}
    SetString(S, PChar(nil), LongLen);
    Stream.Read(Pointer(S)^, LongLen);
    {$else}
    MStream := TMemoryStream.Create;
    MStream.CopyFrom(Stream, LongLen);
    if LongLen > 255 then BLen := 255
    else BLen := LongLen;
    MStream.Position := 0;
    S[0] := Char(BLen);
    MStream.Read(S[1], BLen);
    MStream.Free;
    {$endif}
  end;
end;
procedure TAceAceFile.ReadPChar(var S: PChar; Len: LongInt);
begin
  Stream.Read(S^, Len);
end;
procedure TAceAceFile.ReadStream(S: TStream);
var
  len: LongInt;
begin
  Stream.Read(Len, SizeOf(Len));
  S.CopyFrom(Stream, Len);
end;
procedure TAceAceFile.ReadBoolean(var Value: Boolean);
begin
  Stream.Read(Value, SizeOf(Value));
end;

procedure TAceAceFile.SaveToFile(FileName: String);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(fs);
  finally
    fs.free;
  end;
end;

procedure TAceAceFile.SaveToStream(SaveStream: TStream);
begin
end;

procedure TAceAceFile.LoadFromFile(FileName: String);
var
  str: TFileStream;
begin
  str := TFileStream.Create(FileName, fmOpenRead);
  try
    LoadFromStream(str);
  finally
    str.free;
  end;
end;

procedure TAceAceFile.LoadFromStream(LoadStream: TStream);
var
  Spot, Pos: LongInt;
  pp: TAcePagePosition;
  rc: Word;
  obj: TAceAceFileObject;
  Len: LongInt;
begin
  if Stream <> nil then Clear;
  if FObjects <> nil then Clear;
  FStream := TAceStream.Create;
  FObjects := TList.Create;


  LoadStream.Read(AceFileHeader, SizeOf(AceFileHeader));
  if AceFileHeader.Key = 101071 then
  begin
    Description := StrPas(AceFileHeader.Description);
    LoadStream.Read(AceFileInfo, SizeOf(AceFileInfo));
    if AceFileHeader.Version < 3.0 then
    begin
      LoadStream.Read(AceFilePrinterInfo,
          SizeOf(AceFilePrinterInfo)- SizeOf(AceFilePrinterInfo.CollatedCopies)  );
      AceFilePrinterInfo.CollatedCopies := True;
      AcePrinterSetup.SetPrintInfo( AceFilePrinterInfo );
    end else if AceFileHeader.Version < 4.0 then
    begin
      LoadStream.Read(AceFilePrinterInfo, SizeOf(AceFilePrinterInfo));
      AcePrinterSetup.SetPrintInfo( AceFilePrinterInfo );
    end else
    begin
      LoadStream.Read(rc, SizeOf(rc));
      AcePrinterSetup.ReadFromStream(LoadStream);
    end;

    TMemoryStream(FUserStream).Clear;
    LoadStream.Read(Len, SizeOf(Len));
    if Len > 0 then FUserStream.CopyFrom(LoadStream, Len);

    for spot := 0 to AceFileInfo.pages - 1 do
    begin
      pp := TAcePagePosition.Create;
      LoadStream.Read(pos, SizeOf(pos));
      pp.Pos := pos;
      Pages.Add(pp);
    end;

    for spot := 0 to AceFileInfo.objects - 1 do
    begin
      LoadStream.Read(rc, SizeOf(rc));
      obj := TAceAceFileObject.Create;
      case rc of
        AceRT_Font:
        begin
          obj.ObjectType := aotFont;
          LoadStream.Read(obj.LogFont, SizeOf(TAceLogFont));
        end;
        AceRT_Pen:
        begin
          obj.ObjectType := aotPen;
          LoadStream.Read(obj.LogPen, SizeOf(TAceLogPen));
        end;
        AceRT_Brush:
        begin
          obj.ObjectType := aotBrush;
          LoadStream.Read(obj.LogBrush, SizeOf(TAceLogBrush));
        end;
      end;
      objects.Add(obj);
    end;

    Stream.CopyFrom(LoadStream, LoadStream.Size - LoadStream.Position);
    PercentDone := 100;
  end;
end;

procedure TAceAceFile.PlayPage(DC: THandle; page: LongInt);
var
  pp: TAcePagePosition;
  RecType: Word;
  SavePos: LongInt;
  pos: Integer;
  sSize: LongInt;
begin
  if (Pages.Count > 0) And (Not Running Or
      ((Pages.Count > 1) And (page > 0) And (page < Pages.Count))) then
  begin
    SavePos := Stream.Position;

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


    sSize := Stream.Size;
    ReadType(RecType);
    while (RecType <> AceRT_EndPage) And (Stream.Position < sSize) do
    begin
      PlayRecord(RecType, DC);
      ReadType(RecType);
    end;

    Stream.Position := SavePos;
  end;
end;

function TAceAceFile.GetPageWidth: Integer;
begin
  result := Round(AcePrinterSetup.Width * PixelsPerInchX);
end;
function TAceAceFile.GetPageHeight: Integer;
begin
  result := Round(AcePrinterSetup.Length * PixelsPerInchY);
end;
function TAceAceFile.GetPixelsPerInchX: Integer;
begin
  result := AceFileInfo.PixelsPerInchX;
end;
procedure TAceAceFile.SetPixelsPerInchX( ppi: Integer );
begin
  AceFileInfo.PixelsPerInchX := ppi;
end;
function TAceAceFile.GetPixelsPerInchY: Integer;
begin
  Result := AceFileInfo.PixelsPerInchY;
end;
procedure TAceAceFile.SetPixelsPerInchY( ppi: Integer );
begin
  AceFileInfo.PixelsPerInchY := ppi;
end;



procedure TAceAceFile.PlayRecord(RecType: Integer; DC: THandle);
type
  TPoints = array[0..0] of TPoint;
var
  spot: SmallInt;
  obj: TAceAceFileObject;
  x,y: SmallInt;
  x1,x2,x3,x4,y1,y2,y3,y4: SmallInt;
  gtype: SmallInt;
  Text: String;
  PText: PChar;
  count :LongInt;
  W: Word;
  Rect ,Rect2: TRect;
  Str: TMemoryStream;
  Graphic: TGraphic;
  PrintEvent: TACERecordPrintEvent;
  art: TAceRecType;
  Val: Boolean;
  ValLong: LongInt;
  LI1,LI2: LongInt;
  PX, PY: Integer;
  TempPen: THandle;
  Color: TColor;
  CheckStyle: TAceCheckStyle;
  DrawType: TAceDrawType;
  PolyType: TAcePolyType;
  Retval: Integer;

  PPoints: ^TPoints;


  function SI_XScale(Value: SmallInt): SmallInt;
  begin
    Result := MulDiv(Value, PX, PixelsPerInchX);
  end;
  function SI_YScale(Value: SmallInt): SmallInt;
  begin
    Result := MulDiv(Value, PY, PixelsPerInchY);
  end;
  function LI_XScale(Value: LongInt): LongInt;
  begin
    Result := MulDiv(Value, PX, PixelsPerInchX);
  end;
  function LI_YScale(Value: LongInt): LongInt;
  begin
    Result := MulDiv(Value, PY, PixelsPerInchY);
  end;
  function RectScale(Rect: TRect): TRect;
  var
    h,w: LongInt;
  begin
    Result.Top := SI_YScale(Rect.Top);
    Result.Left := SI_XScale(Rect.Left);
    h := Rect.Bottom - Rect.Top;
    w := Rect.Right - Rect.Left;
    h := SI_YScale(h);
    w := SI_XScale(w);
    Result.Bottom := Result.Top + h;
    Result.Right := Result.Left + w;
  end;
  function SReadRect: TRect;
  begin
    ReadRect(Result);
    Result := RectScale(Result);
  end;
  function SReadSmallIntX: SmallInt;
  begin
    ReadSmallInt(Result);
    Result := SI_XScale(Result);
  end;
  function SReadSmallIntY: SmallInt;
  begin
    ReadSmallInt(Result);
    Result := SI_YScale(Result);
  end;
  function SReadLongIntX: LongInt;
  begin
    ReadLongInt(Result);
    Result := LI_XScale(Result);
  end;
  function SReadLongIntY: LongInt;
  begin
    ReadLongInt(Result);
    Result := LI_YScale(Result);
  end;
begin
  PX := PixelsPerInchX;
  PY := PixelsPerInchY;
  case RecType of
    AceRT_SelectObject:
    begin
      ReadSmallInt(Spot);
      obj := TAceAceFileObject(objects.items[spot]);
      end;
      case obj.objecttype of
        aotFont: LastFont := Spot;
        aotBrush: LastBrush := Spot;
        aotPen: LastPen := Spot;
      end;
    end;
    AceRT_StartPage:
    begin
    end;
    AceRT_EndPage:
    begin
    end;
    AceRT_SetTextAlign:
    begin
      ReadWord(W);
    end;
    AceRT_TextOut:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadString(Text);
    end;
    AceRT_MoveTo:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
    end;
    AceRT_LineTo:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
    end;
    AceRT_PTextOut:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadLongInt(Count);
      PText := StrAlloc(count + 1);
      try
        ReadPChar(PText, Count);
      finally
        StrDispose(PText);
      end;
    end;
    AceRT_ExtTextOut:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;

      W := SReadSmallIntX;

      Rect := SReadRect;

      ReadLongInt(Count);
      PText := StrAlloc(count + 1);
      try
        ReadPChar(PText, Count);
      finally
        StrDispose(PText);
      end;
    end;
    AceRT_TextRect:
    begin
      Rect := SReadRect;
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadString(Text);
      W := ETO_CLIPPED;
    end;
    AceRT_FillRect:
    begin
      Rect := SReadRect;
    end;
    AceRT_Rectangle:
    begin
      x1 := SReadSmallIntX;
      y1 := SReadSmallIntY;
      x2 := SReadSmallIntX;
      y2 := SReadSmallIntY;
    end;
    AceRT_RoundRect:
    begin
      x1 := SReadSmallIntX;
      y1 := SReadSmallIntY;
      x2 := SReadSmallIntX;
      y2 := SReadSmallIntY;
      x3 := SReadSmallIntX;
      y3 := SReadSmallIntY;
    end;
    AceRT_Ellipse:
    begin
      x1 := SReadSmallIntX;
      y1 := SReadSmallIntY;
      x2 := SReadSmallIntX;
      y2 := SReadSmallIntY;
    end;
    AceRT_Draw:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadSmallInt(gtype);
      Str := TMemoryStream.Create;
      try
        ReadStream(Str);
        Str.Position := 0;
      finally
        Str.Free;
      end;
    end;
    AceRT_StretchDraw:
    begin
      Rect := SReadRect;
      ReadSmallInt(gtype);
      Str := TMemoryStream.Create;
      Graphic := nil;
      try
        ReadStream(Str);
        Str.Position := 0;
      finally
        Str.Free;
      end;
    end;
    AceRT_ShadeRect:
    begin
      Rect := SReadRect;
      ReadSmallInt(x);
    end;
    AceRT_PrinterInfo:
    begin
      ReadPrinterInfo(AceFilePrinterInfo);
    end;
    AceRT_NewPrinterInfo:
    begin
      AcePrinterSetup.ReadFromAceFile(Self);
    end;
    AceRT_SetBkColor:
    begin
      ReadLongInt(ValLong);
    end;
    AceRT_TextJustify:
    begin
      Rect := SReadRect;
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadString(Text);
      ReadBoolean( Val );

      { change from version 1.07 to 1.07a }
      if AceFileHeader.Version > 1.0 then Rect2 := SReadRect
      else Rect2 := Rect;
    end;
    AceRT_AceDrawBitmap:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      Str := TMemoryStream.Create;
      try
        ReadStream(Str);
        Str.Position := 0;
      finally
        Str.Free;
      end;
    end;
    AceRT_AceStretchDrawBitmap:
    begin
      Rect := SReadRect;
      Str := TMemoryStream.Create;
      try
        ReadStream(Str);
        Str.Position := 0;
      finally
        Str.Free;
      end;
    end;
    AceRT_RtfDraw:
    begin
      ReadLongInt(Count);
      Rect := SReadRect;
      ReadBoolean(Val);
      ReadLongInt(LI1);
      ReadLongInt(LI2);
      Str := TMemoryStream.Create;
      try
        ReadStream(Str);
        Str.Position := 0;
      finally
        Str.Free;
      end;
    end;
    AceRT_DrawCheckBox:
    begin
      Rect := SReadRect;
      ReadSmallInt(x);
      CheckStyle := TAceCheckStyle(x);
      ReadLongInt(ValLong);
      Color := TColor(ValLong);
      y := SReadSmallIntX;
    end;
    AceRT_DrawShapeType:
    begin
      ReadSmallInt(x);
      DrawType := TAceDrawType(x);
      x1 := SReadLongIntX;
      x2 := SReadLongIntX;
      x3 := SReadLongIntX;
      x4 := SReadLongIntX;
      y1 := SReadLongIntY;
      y2 := SReadLongIntY;
      y3 := SReadLongIntY;
      y4 := SReadLongIntY;
    end;
    AceRT_PolyDrawType:
    begin
      ReadSmallInt(x);
      PolyType := TAcePolyType(x);
      ReadSmallInt(x);
      GetMem(PPoints, x * SizeOf(TPoint));
      for Spot := 0 to x-1 do
      begin
        PPoints^[Spot].X := SReadLongIntX;
        PPoints^[Spot].Y := SReadLongIntY;
      end;
      FreeMem(PPoints, x * SizeOf(TPoint));
    end;
    AceRT_3of9BarCode:
    begin
        x := SReadSmallIntX;
        x := SReadSmallIntY;
        x := SReadSmallIntX;
        x := SReadSmallIntY;
        ReadSmallInt(x1);
        ReadSmallInt(x1);
        ReadBoolean(Val);
        ReadBoolean(Val);
        ReadString(Text);
    end;
    AceRT_2of5BarCode:
    begin
        x := SReadSmallIntX;
        x := SReadSmallIntY;
        x := SReadSmallIntX;
        x := SReadSmallIntY;
        ReadSmallInt(x);
        ReadSmallInt(x);
        ReadBoolean(Val);
        ReadBoolean(Val);
        ReadString(Text);
    end;
  end;

end;


end.