aceout.pas

suite component ace report

    adPrinter:
    begin
  {$IFDEF WIN32}
      windows.StartPage(handle);
  {$ELSE}
      winprocs.StartPage(handle);
  {$ENDIF}
      FixupPage;
      AceCanvas.FontChanged;
    end;
    adNoWhere: { do nothing }
  end;
end;

procedure TAceOutput.Abort;
begin
  AceCanvas.Handle := 0;
  case FDestination of
    adAceFile, adPreview: EndDoc;
    adPrinter:
    begin
      printer.Abort;
      {$ifndef WIN32}
        { the next line is due to a bug in delphi }
  {$IFDEF WIN32}
        windows.AbortDoc(printer.handle);
  {$ELSE}
        winprocs.AbortDoc(printer.handle);
  {$ENDIF}
        EndDoc;
      {$endif}
    end;
    adNoWhere: EndDoc;
  end;
end;


{ TAceCanvas }
constructor TAceCanvas.Create;
begin
  inherited Create;
  if Not AceDemoStringGood(aceutil.demostring1) then Abort;
  FDestination := adPrinter;
  FPen := TPen.Create;
  FPen.OnChange := UpdatePen;
  FFont := TFont.Create;
  FFont.OnChange := UpdateFont;
  FBrush := TBrush.Create;
  FBrush.OnChange := UpdateBrush;

  FSelectFont  := 0;
  FSelectBrush := 0;
  FSelectPen   := 0;

  FPixelsPerInchX := Screen.PixelsPerInch;
  FPixelsPerInchY := Screen.PixelsPerInch;
end;

destructor TAceCanvas.Destroy;
begin
  Handle := 0;
  if FPen <> nil then FPen.free;
  if FFont <> nil then FFont.free;
  if FBrush <> nil then FBrush.free;

  {$IFDEF WIN32}
  if FSelectFont <> 0 then windows.DeleteObject(FSelectFont);
  if FSelectBrush <> 0 then windows.DeleteObject(FSelectBrush);
  if FSelectPen <> 0 then windows.DeleteObject(FSelectPen);
  {$ELSE}
  if FSelectFont <> 0 then winprocs.DeleteObject(FSelectFont);
  if FSelectBrush <> 0 then winprocs.DeleteObject(FSelectBrush);
  if FSelectPen <> 0 then winprocs.DeleteObject(FSelectPen);
  {$ENDIF}
  inherited Destroy;
end;

procedure TAceCanvas.SetFont(f: TFont);
begin
  FFont.Assign(f);
end;

procedure TAceCanvas.SetLogFont(LF: TLogFont);
begin
  FLogFont := LF;
  FLogFont.lfHeight := -MulDiv(FFont.Size, PixelsPerInchY, 72);
  SelectFont := 0;
  FontChanged;
end;
procedure TAceCanvas.SetLogBrush(LB: TLogBrush);
begin
  FLogBrush := LB;
  SelectBrush := 0;
end;
procedure TAceCanvas.SetLogPen(LP: TLogPen);
begin
  FLogPen := LP;
  SelectPen := 0;
end;

procedure TAceCanvas.SetSelectFont(hnd: THandle);
var
  StockFont: THandle;
begin
  if FSelectFont <> 0 then
  begin
  {$IFDEF WIN32}
    StockFont := windows.GetStockObject(SYSTEM_FONT);
    windows.SelectObject(FHandle, StockFont);
    windows.DeleteObject(FSelectFont);
  {$ELSE}
    StockFont := winprocs.GetStockObject(SYSTEM_FONT);
    winprocs.SelectObject(FHandle, StockFont);
    winprocs.DeleteObject(FSelectFont);
  {$ENDIF}
  end;
  FSelectFont := hnd;
end;
function TAceCanvas.GetSelectFont: THandle;
begin
  if FSelectFont = 0 then
  begin
    FSelectFont := CreateFontIndirect(FLogFont);
  end;
  result := FSelectFont;
end;
procedure TAceCanvas.SetSelectBrush(hnd: THandle);
var
  StockBrush: THandle;
begin
  if FSelectBrush <> 0 then
  begin
  {$IFDEF WIN32}
    StockBrush := windows.GetStockObject(HOLLOW_BRUSH);
    windows.SelectObject(FHandle, StockBrush);
    windows.DeleteObject(FSelectBrush);
  {$ELSE}
    StockBrush := winprocs.GetStockObject(HOLLOW_BRUSH);
    winprocs.SelectObject(FHandle, StockBrush);
    winprocs.DeleteObject(FSelectBrush);
  {$ENDIF}
  end;
  FSelectBrush := hnd;
end;
function TAceCanvas.GetSelectBrush: THandle;
begin
  if FSelectBrush = 0 then
  begin
    FSelectBrush := CreateBrushIndirect(FLogBrush);
  end;
  result := FSelectBrush;
end;
procedure TAceCanvas.SetSelectPen(hnd: THandle);
var
  StockPen: THandle;
begin
  if FSelectPen <> 0 then
  begin
  {$IFDEF WIN32}
    StockPen := windows.GetStockObject(BLACK_PEN);
    windows.SelectObject(FHandle, StockPen);
    windows.DeleteObject(FSelectPen);
  {$ELSE}
    StockPen := winprocs.GetStockObject(BLACK_PEN);
    winprocs.SelectObject(FHandle, StockPen);
    winprocs.DeleteObject(FSelectPen);
  {$ENDIF}
  end;
  FSelectPen := hnd;
end;
function TAceCanvas.GetSelectPen: THandle;
begin
  if FSelectPen = 0 then
  begin
    FSelectPen := CreatePenIndirect(FLogPen);
  end;
  result := FSelectPen;
end;

procedure TAceCanvas.UpdateFont(Sender: TObject);
var
  lf: TLogFont;
begin
  AceGetObject(FFont.Handle, SizeOf(TLogFont), Addr(lf));
  LogFont := lf;

  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.SetLogFont(FFont, FLogFont);
    adPrinter: FontChanged;
    adNoWhere:;
  end;
end;

procedure TAceCanvas.FontChanged;
begin
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.SetLogFont(FFont, LogFont);
    adPrinter:
    begin
  {$IFDEF WIN32}
      windows.SelectObject(Handle, SelectFont);
      windows.SetTextColor(Handle, ColorToRGB(FFont.Color));
  {$ELSE}
      winprocs.SelectObject(Handle, SelectFont);
      winprocs.SetTextColor(Handle, ColorToRGB(FFont.Color));
  {$ENDIF}
    end;
    adNoWhere:;
  end;
end;

procedure TAceCanvas.UpdatePen(Sender: TObject);
var
  lp: TLogPen;
begin
  AceGetObject(FPen.Handle, SizeOf(TLogPen), Addr(lp));
  LogPen := lp;
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.SetPen(Pen);
    adPrinter:
    begin
  {$IFDEF WIN32}
      windows.SelectObject(Handle, SelectPen);
  {$ELSE}
      winprocs.SelectObject(Handle, SelectPen);
  {$ENDIF}
    end;
    adNoWhere:;
  end;
end;

procedure TAceCanvas.UpdateBrush(Sender: TObject);
var
  lb: TLogBrush;
begin
  AceGetObject(FBrush.Handle, SizeOf(TLogBrush), Addr(lb));
  LogBrush := lb;
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.SetBrush(Brush);
    adPrinter:
    begin
  {$IFDEF WIN32}
      windows.SelectObject(Handle, SelectBrush);
      windows.SetBkColor(Handle, LogBrush.lbColor);
      if LogBrush.lbStyle = BS_Solid then windows.SetBkMode(Handle, OPAQUE)
      else windows.SetBkMode(Handle, TRANSPARENT);
  {$ELSE}
      winprocs.SelectObject(Handle, SelectBrush);
      winprocs.SetBkColor(Handle, LogBrush.lbColor);
      if LogBrush.lbStyle = BS_Solid then winprocs.SetBkMode(Handle, OPAQUE)
      else winprocs.SetBkMode(Handle, TRANSPARENT);
  {$ENDIF}
    end;
    adNoWhere: ;
  end;
end;

procedure TAceCanvas.SetBrush(b: TBrush);
begin
  FBrush.Assign(b);
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.SetBrush(FBrush);
    adPrinter: UpdateBrush(FBrush);
    adNoWhere: ;
  end;
end;

procedure TAceCanvas.SetPen(p: TPen);
begin
  FPen.Assign(p);
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.SetPen(FPen);
    adPrinter: UpdatePen(FPen);
    adNoWhere: ;
  end;
end;

procedure TAceCanvas.SetHandle( hnd: THandle );
begin
  FPen.OnChange := nil;
  FFont.OnChange := nil;
  FBrush.OnChange := nil;

  SelectFont := 0;
  FFont.Handle := GetStockObject(SYSTEM_FONT);
  SelectPen := 0;
  FPen.Handle := GetStockObject(BLACK_PEN);
  SelectBrush := 0;
  FBrush.Handle := GetStockObject(HOLLOW_BRUSH);

  FPen.OnChange := UpdatePen;
  FFont.OnChange := UpdateFont;
  FBrush.OnChange := UpdateBrush;

  FHandle := hnd;
end;

procedure TAceCanvas.SetTextAlign(flags: Word);
begin
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.SetTextAlign(flags);
    adPrinter:
    begin
  {$IFDEF WIN32}
       windows.SetTextAlign(Handle,flags);
  {$ELSE}
       winprocs.SetTextAlign(Handle,flags);
  {$ENDIF}
    end;
    adNoWhere: ;
  end;
end;
procedure TAceCanvas.TextOut(x,y: Integer; const Text: String);
var
  str: String;
begin
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.TextOut(x,y,Text);
    adPrinter:
    begin
      str := Text;
  {$IFDEF WIN32}
      windows.TextOut(Handle, x, y, @Str[1], Length(str));
  {$ELSE}
      winprocs.TextOut(Handle, x, y, @Str[1], Length(str));
  {$ENDIF}
    end;
    adNoWhere: ;
  end;
end;
procedure TAceCanvas.MoveTo(x,y: Integer);
begin
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.MoveTo(x,y);
    adPrinter:
    begin
{$IFDEF WIN32}
      windows.MoveToEx(Handle, x, y, nil);
{$ELSE}
      winprocs.MoveTo(Handle, x, y);
{$ENDIF}
    end;
    adNoWhere: ;
  end;
end;
procedure TAceCanvas.LineTo(x,y: Integer);
begin
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.LineTo(x,y);
    adPrinter:
    begin
  {$IFDEF WIN32}
      windows.LineTo(Handle, x, y);
  {$ELSE}
      winprocs.LineTo(Handle, x, y);
  {$ENDIF}

    end;
    adNoWhere: ;
  end;
end;
procedure TAceCanvas.PTextOut(x,y: Integer; Text: PChar; count: LongInt);
begin
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.PTextOut(x,y,Text,count);
    adPrinter:
    begin
  {$IFDEF WIN32}
      windows.TextOut(Handle, x,y,Text, count);
  {$ELSE}
      winprocs.TextOut(Handle, x,y,Text, count);
  {$ENDIF}
    end;
    adNoWhere: ;
  end;
end;
procedure TAceCanvas.ExtTextOut(x,y: Integer; Options: Word; Rect: TRect; Text: PChar; count: word);
begin
  case FDestination of
    adAceFile, adPreview: AceOutput.AceFile.ExtTextOut(x,y,Options,Rect,Text,count);
    adPrinter:
    begin
  {$IFDEF WIN32}
      windows.ExtTextOut(Handle, x, y, Options, @Rect, Text, count, nil);
  {$ELSE}
      winprocs.ExtTextOut(Handle, x, y, Options, @Rect, Text, count, nil);
  {$ENDIF}
    end;
    adNoWhere: ;
  end;
end;
procedure TAceCanvas.TextRect(rect: TRect; x,y: Integer; const Text: string);