acefile.pas

suite component ace report

{ TAcePrinter }
constructor TAcePrinter.Create;
begin
  inherited Create;
  FAbortPrinting := False;
  FStopPrinting := False;
  FOnStatus := nil;
end;
{ This is just to suppress abstract warning }
procedure TAcePrinter.LoadAceFile(AceFile: TAceFile); begin end;
procedure TAcePrinter.Send(AceFile: TAceFile); begin end;
procedure TAcePrinter.SendPage(AceFile: TAceFile; Page: LongInt); begin end;
procedure TAcePrinter.SendPages(AceFile: TAceFile; StartPage, EndPage: LongInt); begin end;
procedure TAcePrinter.SaveToFile(FileName: String); begin end;
procedure TAcePrinter.SaveToStream(SaveStream: TStream); begin end;
procedure TAcePrinter.PlayPage(DC: THandle; Page: LongInt); begin end;
{procedure TAcePrinter.Scale(DC: THandle); begin end;}


destructor TAcePrinter.Destroy;
begin

  inherited Destroy;
end;

procedure TAcePrinter.LoadPage(AceFile: TAceFile; page: LongInt);
var
  af: TAceAceFile;
begin
  af := TAceAceFile(AceFile);
  if af.Running then
  begin
    { adjust the ending page if it isn't generated yet }
    if Page >= af.Pages.Count then Page := af.Pages.Count - 1;
  end else
  begin
    if Page >= af.Pages.Count then Page := af.Pages.Count;
  end;
  if Page < 1 then Page := 1;


  LoadPages(AceFile, page, page);
end;

procedure TAcePrinter.LoadPages(AceFile: TAceFile; StartPage, EndPage: LongInt);
var
  output: TAceOutput;
  Spot: LongInt;
  af: TAceAceFile;
  ok: Boolean;
  AceCopies, CopySpot: Integer;
  CollatedCopies: Boolean;

{  ph,pw: Double;
  vscale, hscale: Integer;}
  SaveDuplex: Integer;
  CompareAPS: TAcePrinterSetup;
  SetAPS: Boolean;
begin
  FAbortPrinting := False;
  FStopPrinting := False;

  SaveDuplex := -1;

  af := TAceAceFile(AceFile);


  ok := True;
  if af.Running then
  begin
    { adjust the ending page if it isn't generated yet }
    if EndPage >= af.Pages.Count then EndPage := af.Pages.Count - 1;
  end else
  begin
    if EndPage > af.Pages.Count then EndPage := af.Pages.Count;
  end;
  if StartPage < 1 then StartPage := 1;
  if StartPage > EndPage then ok := False;


  CopySpot := 0;
  if ok then
  begin
    CompareAPS := TAcePrinterSetup.Create;
    output := TAceOutput.Create;
    try
      output.Description := af.Description;
      output.Destination := adPrinter;

      { kmm 1/23 changed 1 to startpage }
      af.GetPagePrinterInfo(AceFile.AcePrinterSetup, StartPage);
{      pw := af.AcePrinterSetup.Width;
      ph := af.AcePrinterSetup.Length;}
      if Not FIgnorePrinterSettings then
      begin
        AceCopies := AceFile.AcePrinterSetup.Copies;
        AceFile.AcePrinterSetup.Copies := 1;
        CollatedCopies := AceFile.AcePrinterSetup.CollatedCopies;
        AceFile.AcePrinterSetup.SetData;
        AceFile.AcePrinterSetup.GetData;
      end else
      begin
        AceFile.AcePrinterSetup.GetData;
        AceCopies := AceFile.AcePrinterSetup.Copies;
        CollatedCopies := AceFile.AcePrinterSetup.CollatedCopies;
        if AceFile.AcePrinterSetup.Copies > 1 then
        begin
          AceFile.AcePrinterSetup.Copies := 1;
          AceFile.AcePrinterSetup.SetData;
        end;
      end;
      Output.AcePrinterSetup := AceFile.AcePrinterSetup;
      CompareAPS.Assign(AceFile.AcePrinterSetup);

      FPageNumber := StartPage;
      if Assigned(FOnStatus) then FOnStatus(Self);
      output.BeginDoc;
{
      if ph = 0 then vscale := 100
      else vscale := round(output.AcePrinterSetup.Length / ph * 100);
      if pw = 0 then hscale := 100
      else hscale := round(output.AcePrinterSetup.Width / pw * 100);
      if vscale < hscale then hscale := vscale
      else vscale := hscale;
      AceFile.HorzScale := vscale;
      AceFile.VertScale := hscale;
 }
      AceFile.HorzScale := 100;
      AceFile.VertScale := 100;
      AceFile.SetOrigin := True;


      Spot := StartPage;
      while Spot <= EndPage do
      begin
        FPageNumber := Spot;
        if Assigned(FOnStatus) then FOnStatus(Self);
        if Not (FAbortPrinting or FStopPrinting) then
        begin
          if (SaveDuplex <> -1) And DuplexNewJob then
          begin
            af.GetPagePrinterInfo(AceFile.AcePrinterSetup, Spot);
            if AceFile.AcePrinterSetup.Duplex <> SaveDuplex then
            begin
              Output.EndDoc;
              Output.AcePrinterSetup := AceFile.AcePrinterSetup;
              Output.AcePrinterSetup.Copies := 1;
              Output.BeginDoc;
            end;
          end;
          if (Spot > StartPage) or (CopySpot > 0) then
          begin
            if Not FIgnorePrinterSettings then
            begin
              if (CopySpot = 0) or CollatedCopies then
              begin
                SetAPS := True;
                AceFile.AcePrinterSetup.Copies := AceCopies;
                af.GetPagePrinterInfo(AceFile.AcePrinterSetup, Spot);
                if (Spot > StartPage) then
                begin
                  af.GetPagePrinterInfo(CompareAPS, Spot-1);
                  CompareAPS.Copies := 1;
                  SetAPS := Not CompareAPS.IsRunningEqual(AceFile.AcePrinterSetup);
                end;
                if SetAPS then
                begin
                  if Not CollatedCopies then AceCopies := AceFile.AcePrinterSetup.Copies;
                  AceFile.AcePrinterSetup.Copies := 1;
                  af.AcePrinterSetup.SetData;
                end;
              end;
            end;
            af.AcePrinterSetup.GetData;

            {$IFDEF WIN32}
        {    windows.StartPage(output.handle);}
            {$ELSE}
        {    winprocs.StartPage(output.handle);}
            {$ENDIF}
            output.StartPage;
          end;

          AceFile.OrgX := -Round(AceFile.AcePrinterSetup.LeftPrintArea * TAceAceFile(AceFile).PixelsPerInchX);
          AceFile.OrgY := -Round(AceFile.AcePrinterSetup.TopPrintArea * TAceAceFile(AceFile).PixelsPerInchY);

{          AceFile.Scale(output.handle);}
          AceFile.PlayPage(output.handle, Spot);
          output.EndPage;
        end;
        Application.ProcessMessages;
        if AceCopies > 1 then
        begin
          if CollatedCopies then
          begin
            Inc(Spot);
            if Spot > EndPage then
            begin
              Inc(CopySpot);
              if CopySpot < AceCopies then
              begin
                Spot := StartPage;
                if AceFile.AcePrinterSetup.Duplex <> 1 then
                begin
                  Output.EndDoc;
                  Output.AcePrinterSetup := AceFile.AcePrinterSetup;
                  Output.AcePrinterSetup.Copies := 1;
                  Output.BeginDoc;
                end;
              end;
            end;
          end else
          begin
            Inc(CopySpot);
            if CopySpot >= AceCopies then
            begin
              CopySpot := 0;
              Inc(Spot);
            end;
          end;
        end else Inc(Spot);
        SaveDuplex := AceFile.AcePrinterSetup.Duplex;
      end;

      AceFile.SetOrigin := False;

      if FAbortPrinting then output.Abort
      else output.EndDoc;
      if Assigned(FOnStatus) then FOnStatus(Self);
    finally
      output.Free;
      CompareAPS.Free;
    end;
  end;
end;

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

procedure TAcePrinter.LoadFromStream(LoadStream: TStream);
begin
end;

{ TAceDeviceContext }
constructor TAceDeviceContext.Create;
begin
  inherited Create;
  FDC := 0;
end;

{ This is just to suppress abstract warning }
procedure TAceDeviceContext.LoadAceFile(AceFile: TAceFile); begin end;
procedure TAceDeviceContext.LoadPages(AceFile: TAceFile; StartPage, EndPage: LongInt); begin end;
procedure TAceDeviceContext.Send(AceFile: TAceFile); begin end;
procedure TAceDeviceContext.SendPage(AceFile: TAceFile; Page: LongInt); begin end;
procedure TAceDeviceContext.SendPages(AceFile: TAceFile; StartPage, EndPage: LongInt); begin end;
procedure TAceDeviceContext.SaveToFile(FileName: String); begin end;
procedure TAceDeviceContext.SaveToStream(SaveStream: TStream); begin end;
procedure TAceDeviceContext.PlayPage(DC: THandle; Page: LongInt); begin end;


destructor TAceDeviceContext.Destroy;
begin

  inherited Destroy;
end;

procedure TAceDeviceContext.SetDC(DevContext: THandle);
begin
  FDC := DevContext;
end;


procedure TAceDeviceContext.LoadPage(AceFile: TAceFile; page: LongInt);
var
  af: TAceAceFile;
begin
{  AceFile.Scale(DC);}

  af := TAceAceFile(AceFile);
  if af.Running then
  begin
    { adjust the ending page if it isn't generated yet }
    if Page >= af.Pages.Count then Page := af.Pages.Count - 1;
  end else
  begin
    if Page >= af.Pages.Count then Page := af.Pages.Count;
  end;
  if Page < 1 then Page := 1;


  AceFile.PlayPage(DC, page);
end;

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

procedure TAceDeviceContext.LoadFromStream(LoadStream: TStream);
begin
end;


{ TAceAceObject }
constructor TAceAceFileObject.Create;
begin
  inherited Create;
  ObjectType := aotNone;
  Pen := nil;
  Brush := nil;
  Font := nil;
  SelectFont := 0;
  SelectBrush := 0;
  SelectPen := 0;
end;
destructor TAceAceFileObject.Destroy;
begin
  if Pen <> nil then Pen.Free;
  if Brush <> nil then Brush.Free;
  if Font <> nil then Font.Free;
  {$IFDEF WIN32}
  if SelectFont <> 0 then windows.DeleteObject(SelectFont);
  if SelectBrush <> 0 then windows.DeleteObject(SelectBrush);
  if SelectPen <> 0 then windows.DeleteObject(SelectPen);
  {$ELSE}
  if SelectFont <> 0 then winprocs.DeleteObject(SelectFont);
  if SelectBrush <> 0 then winprocs.DeleteObject(SelectBrush);
  if SelectPen <> 0 then winprocs.DeleteObject(SelectPen);
  {$ENDIF}

  inherited Destroy;
end;
procedure TAceAceFileObject.CreateObject(PixelsPerInchY: Integer);
var
  fs: TFontStyles;
  lf: TLogFont;
  lb: TLogBrush;
  lp: TLogPen;
  Retval: Integer;
begin
  case ObjectType of
    aotFont:
    begin
      if Font = nil then
      begin
        Font := TFont.Create;
        with lf do
        begin
          lfHeight := -MulDiv(LogFont.Size, PixelsPerInchY, 72);
          lfWidth := 0;
          lfOrientation := 0;
          lfItalic := LogFont.Italic;
          lfUnderline := LogFont.UnderLine;
          lfStrikeOut := LogFont.StrikeOut;
          lfEscapement := LogFont.Escapement;
          lfWeight := LogFont.Weight;
          lfCharSet := LogFont.CharSet;
          lfOutPrecision := LogFont.OutPrecision;
          lfClipPrecision := LogFont.ClipPrecision;
          lfQuality := LogFont.Quality;
          lfPitchAndFamily := LogFont.PitchAndFamily;
          StrLCopy(lfFaceName, LogFont.Name, SizeOf(LogFont.Name));
        end;
        SelectFont := CreateFontIndirect(lf);
        Font.Handle := CreateFontIndirect(lf);

        Font.Name := StrPas(LogFont.Name);
        Font.PixelsPerInch := PixelsPerInchY;
        Font.Color := LogFont.Color;
        Font.Size := LogFont.Size;
        Font.Height := lf.lfHeight;
        if (logfont.PitchAndFamily And DEFAULT_PITCH) = 0 then Font.Pitch := fpDefault
        else if (LogFont.PitchAndFamily And VARIABLE_PITCH) = 0 then Font.Pitch := fpVariable
        else if (LogFont.PitchAndFamily And FIXED_PITCH) = 0 then Font.Pitch := fpFixed;
        fs := [];
        if LogFont.Weight <> FW_DONTCARE then Include(fs, fsBold);
        if LogFont.Italic <> 0 then Include(fs, fsItalic);
        if LogFont.UnderLine <> 0 then Include(fs, fsUnderline);
        if LogFont.StrikeOut <> 0 then Include(fs, fsStrikeout);
        Font.Style := fs;

      end;
    end;
    aotBrush:
    begin
      if Brush = nil then
      begin
        Brush := TBrush.Create;
        Brush.Color := LogBrush.Color;
        Brush.Style := LogBrush.Style;
        Retval := AceGetObject(Brush.handle, SizeOf(TLogBrush), Addr(lb));
        if Retval = 0 then SelectBrush := 0
        else SelectBrush := CreateBrushIndirect(lb);
      end;

    end;
    aotPen:
    begin
      if Pen = nil then
      begin
        Pen := TPen.Create;
        Pen.Color := LogPen.Color;
        Pen.Width := LogPen.Width;
        Pen.Mode  := LogPen.Mode;
        Pen.Style := LogPen.Style;
        AceGetObject(Pen.handle, SizeOf(TLogPen), Addr(lp));
        SelectPen := CreatePenIndirect(lp);
      end;

    end;
  end;
end;
procedure TAceAceFileObject.DeleteObject;
begin
  case ObjectType of
    aotFont:
    begin
      if Font <> nil then Font.Free;
  {$IFDEF WIN32}
      if SelectFont <> 0 then windows.DeleteObject(SelectFont) ;
  {$ELSE}
      if SelectFont <> 0 then winprocs.DeleteObject(SelectFont) ;
  {$ENDIF}
      Font := nil;
      SelectFont := 0;
    end;
    aotBrush:
    begin
      if Brush <> nil then Brush.Free;
  {$IFDEF WIN32}
      if SelectBrush <> 0 then windows.DeleteObject(SelectBrush);
  {$ELSE}
      if SelectBrush <> 0 then winprocs.DeleteObject(SelectBrush);
  {$ENDIF}
      Brush := nil;
      SelectBrush := 0;
    end;
    aotPen:
    begin
      if Pen <> nil then Pen.Free;
  {$IFDEF WIN32}
      if SelectPen <> 0 then windows.DeleteObject(SelectPen);
  {$ELSE}
      if SelectPen <> 0 then winprocs.DeleteObject(SelectPen);
  {$ENDIF}
      Pen := nil;
      SelectPen := 0;
    end;
  end;
end;

function TAceAceFileObject.FontSame(lf: TAceLogFont): Boolean;
begin
  result := AceIsPCharEqual(@LogFont, @lf, SizeOf(LogFont) - SizeOf(LogFont.Name));
  if result And (StrComp(LogFont.Name, lf.Name) <> 0)  then result := False;
end;

function TAceAceFileObject.PenSame(lp: TAceLogPen): Boolean;
begin
  result := AceIsPCharEqual(@lp, @LogPen, SizeOf(LogPen));
end;

function TAceAceFileObject.BrushSame(lb: TAceLogBrush): Boolean;
begin