acefile.pas

suite component ace report

      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;
  hnd: THandle;
  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;

{    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;
    if Page < 1 then Page := 1;
 }
    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;
    if AceIsDemo then PrintDemoBanner(DC, AcePrinterSetup.Width / 2, AcePrinterSetup.Length / 2,
                                          HorzScale, VertScale);

    { Select StockObjects }
  {$IFDEF WIN32}
    hnd := windows.GetStockObject(SYSTEM_FONT);
    windows.SelectObject(DC, hnd);
    hnd := windows.GetStockObject(HOLLOW_BRUSH);
    windows.SelectObject(DC, hnd);
    hnd := windows.GetStockObject(BLACK_PEN);
    windows.SelectObject(DC, hnd);
  {$ELSE}
    hnd := winprocs.GetStockObject(SYSTEM_FONT);
    winprocs.SelectObject(DC, hnd);
    hnd := winprocs.GetStockObject(HOLLOW_BRUSH);
    winprocs.SelectObject(DC, hnd);
    hnd := winprocs.GetStockObject(BLACK_PEN);
    winprocs.SelectObject(DC, hnd);
  {$ENDIF}

    for pos := 0 to Objects.count - 1 do
    begin
      TAceAceFileObject(Objects.items[pos]).DeleteObject;
    end;

    Stream.Position := SavePos;
  end;
end;
{
procedure TAceAceFile.Scale(DC: THandle);
var
  w,h: LongInt;
begin
  if (HorzScale <> 100) Or (VertScale <> 100) then
  begin
    w := Round(AcePrinterSetup.Width  * GetDeviceCaps(DC, LOGPIXELSX));
    h := Round(AcePrinterSetup.Length * GetDeviceCaps(DC, LOGPIXELSY));
    AceScale(DC,PageWidth, PageHeight, w, h, HorzScale, VertScale);
    if SetOrigin then AceSetOrigin(DC, PixelsPerInchX, PixelsPerInchY, OrgX, OrgY);
  end else
  begin
    AceScale(DC,PageWidth, PageHeight, PageWidth, PageHeight, HorzScale, VertScale);
    if SetOrigin then AceSetOrigin(DC, PixelsPerInchX, PixelsPerInchY, OrgX, OrgY);
  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;
{    Result.Bottom := SI_YScale(Rect.Bottom);
    Result.Right := SI_XScale(Rect.Right);}
  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;

  procedure PushTempPen;
  var
    MyObj: TAceAceFileObject;
    lp: TLogPen;
  begin
    if LastPen <> -1 then
    begin
      MyObj := TAceAceFileObject(objects.items[LastPen]);
      Retval := GetObject(MyObj.SelectPen, SizeOf(TLogPen), Addr(lp));
      lp.lopnWidth.x := SI_XScale(lp.lopnWidth.x);
      TempPen := CreatePenIndirect(lp);
      SelectObject(DC, TempPen);
    end;
  end;
  procedure PopTempPen;
  var
    MyObj: TAceAceFileObject;
  begin
    if LastPen <> -1 then
    begin
      MyObj := TAceAceFileObject(objects.items[LastPen]);
      SelectObject(DC, MyObj.SelectPen);
      DeleteObject(TempPen);
    end;
  end;

begin
  PX := GetDeviceCaps(DC, LOGPIXELSX);
  if HorzScale <> 100 then PX := MulDiv(PX, HorzScale, 100);
  PY := GetDeviceCaps(DC, LOGPIXELSY);
  if VertScale <> 100 then PY := MulDiv(PY, VertScale, 100);
  case RecType of
    AceRT_SelectObject:
    begin
      ReadSmallInt(Spot);
      obj := TAceAceFileObject(objects.items[spot]);
      obj.CreateObject(PY);
      case obj.objecttype of
        aotFont:
        begin
          SelectObject(DC, obj.SelectFont);
          SetTextColor(DC, ColorToRGB(obj.Font.Color));
        end;
        aotBrush:
        begin
          SelectObject(DC, obj.SelectBrush);
  {$IFDEF WIN32}
          windows.SetBkColor(DC, ColorToRGB(obj.LogBrush.Color));
  {$ELSE}
          winprocs.SetBkColor(DC, ColorToRGB(obj.LogBrush.Color));
  {$ENDIF}
          if obj.LogBrush.Style = bsSolid then SetBkMode(DC, OPAQUE)
          else SetBkMode(DC, TRANSPARENT);
        end;
        aotPen:
        begin
          SelectObject(DC, obj.SelectPen);
        end;
      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);
  {$IFDEF WIN32}
      windows.SetTextAlign(DC, W);
  {$ELSE}
      winprocs.SetTextAlign(DC, W);
  {$ENDIF}
    end;
    AceRT_TextOut:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadString(Text);
  {$IFDEF WIN32}
      windows.TextOut(DC, x, y, @Text[1], Length(Text));
  {$ELSE}
      winprocs.TextOut(DC, x, y, @Text[1], Length(Text));
  {$ENDIF}
    end;
    AceRT_MoveTo:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
{$IFDEF WIN32}
      windows.MoveToEx(DC, x, y, nil);
{$ELSE}
      winprocs.MoveTo(DC, x, y);
{$ENDIF}
    end;
    AceRT_LineTo:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
  {$IFDEF WIN32}
      windows.LineTo(DC,x,y);
  {$ELSE}
      winprocs.LineTo(DC,x,y);
  {$ENDIF}
    end;
    AceRT_PTextOut:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadLongInt(Count);
      PText := StrAlloc(count + 1);
      try
        ReadPChar(PText, Count);
  {$IFDEF WIN32}
        windows.TextOut(DC, x, y, PText, count);
  {$ELSE}
        winprocs.TextOut(DC, x, y, PText, count);
  {$ENDIF}
      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);
  {$IFDEF WIN32}
        windows.ExtTextOut(DC, x, y, W, @Rect, PText, count, nil);
  {$ELSE}
        winprocs.ExtTextOut(DC, x, y, W, @Rect, PText, count, nil);
  {$ENDIF}
      finally
        StrDispose(PText);
      end;
    end;
    AceRT_TextRect:
    begin
      Rect := SReadRect;
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadString(Text);
      W := ETO_CLIPPED;
      if LastBrush <> -1 then
      begin
        obj := TAceAceFileObject(objects.items[LastBrush]);
        obj.CreateObject(PY);
        if obj.LogBrush.Style <> bsClear then Inc(W, ETO_OPAQUE);
      end;

  {$IFDEF WIN32}
      windows.ExtTextOut(DC, x, y, W, @Rect, @Text[1], Length(Text), nil);
  {$ELSE}
      WinProcs.ExtTextOut(DC, x, y, W, @Rect, @Text[1], Length(Text), nil);
  {$ENDIF}
    end;
    AceRT_FillRect:
    begin
      Rect := SReadRect;
      if AceIsScreen(DC) then
      begin
        if Rect.Right <= Rect.Left then Rect.Right := Rect.Left + 1;
        if Rect.Bottom <= Rect.Top then Rect.Bottom := Rect.Top + 1;
      end;
      if LastBrush <> -1 then
      begin
        obj := TAceAceFileObject(objects.items[LastBrush]);
        obj.CreateObject(PY);
  {$IFDEF WIN32}
        windows.FillRect(DC, Rect, obj.SelectBrush);
  {$ELSE}
        WinProcs.FillRect(DC, Rect, obj.SelectBrush);
  {$ENDIF}
      end;


    end;
    AceRT_Rectangle:
    begin
      x1 := SReadSmallIntX;
      y1 := SReadSmallIntY;
      x2 := SReadSmallIntX;
      y2 := SReadSmallIntY;
      PushTempPen;
  {$IFDEF WIN32}
      windows.Rectangle(DC, X1, Y1, X2, Y2);
  {$ELSE}
      WinProcs.Rectangle(DC, X1, Y1, X2, Y2);
  {$ENDIF}
      PopTempPen;
    end;
    AceRT_RoundRect:
    begin
      x1 := SReadSmallIntX;
      y1 := SReadSmallIntY;
      x2 := SReadSmallIntX;
      y2 := SReadSmallIntY;
      x3 := SReadSmallIntX;
      y3 := SReadSmallIntY;

      PushTempPen;
  {$IFDEF WIN32}
      windows.RoundRect(DC, X1, Y1, X2, Y2, x3, y3);
  {$ELSE}
      WinProcs.RoundRect(DC, X1, Y1, X2, Y2, x3, y3);
  {$ENDIF}
      PopTempPen;
    end;
    AceRT_Ellipse:
    begin
      x1 := SReadSmallIntX;
      y1 := SReadSmallIntY;
      x2 := SReadSmallIntX;
      y2 := SReadSmallIntY;
      PushTempPen;
  {$IFDEF WIN32}
      windows.Ellipse(DC, X1, Y1, X2, Y2);
  {$ELSE}
      WinProcs.Ellipse(DC, X1, Y1, X2, Y2);
  {$ENDIF}
      PopTempPen;
    end;
    AceRT_Draw:
    begin
      x := SReadSmallIntX;
      y := SReadSmallIntY;
      ReadSmallInt(gtype);
      Str := TMemoryStream.Create;
      Graphic := nil;
      try
        ReadStream(Str);
        Str.Position := 0;
        Graphic := AceGetGraphic(Str);
        if Graphic <> nil then
        begin
          {// Always stretch draw}
          Rect := Bounds(x,y,SI_XScale(Graphic.Width), SI_YScale(Graphic.Height));