acertfc.pas

suite component ace report

unit AceRtfC;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}

uses sctctrl, sctvar,acertfp, classes, aceout, windows
      ,controls, sctrtf;

type
{ TSctRichTextLabel }
  TSctRichTextLabel = class(TSctLabel)
  private
    FVariable: TSctvar;
    FRtfDraw: TAceRtfDraw;
    FBottomMargin: Integer;
    FSetDefaultFont: Boolean;
  protected
    function GetDisplayText: string; override;
    procedure Paint; override;
    procedure DefineProperties(Filer: TFiler); override;
    function PrintMemo( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer): Integer;
  public
    constructor Create(AOwner: Tcomponent); override;
    destructor Destroy; override;
    procedure SetVariable(variable: TSctvar);
    function GetDataNow: String; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

    procedure Print(oPage: TComponent; Space: Integer); override;
    procedure StartPrint; override;
    function PrintHeight( oPage: TComponent; Space, Taking: Integer): Integer; override;
    function SpendHeight(oPage: TComponent; Space: Integer): Integer; override;
    procedure PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer); override;
    procedure PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer); override;
  published
    property Variable: TSctvar read FVariable write setvariable;

    property Align;
    property Color;
    property Font;
    property ParentColor;
    property ParentFont;
    property Transparent;

    property ClipType;
    property AlignVertical;
    property AlignHorizontal;

    property Stretch;
    property BorderType;

    property Shade;
    property BorderMargin;

    property BottomMargin: Integer read FBottomMargin write FBottomMargin;
    property SetDefaultFont: Boolean read FSetDefaultFont write FSetDefaultFont default False;

  end;


implementation

uses sctrep, acememou, printers, forms;


constructor TSctRichTextLabel.Create(AOwner: Tcomponent);
begin
  inherited Create(AOwner);
  FRtfDraw := TAceRtfDraw.Create;
  FBottomMargin := 20;
  FSetDefaultFont := False;
end;

destructor TSctRichTextLabel.Destroy;
begin
  if FRtfDraw <> nil then FRtfDraw.Free;
  inherited Destroy;
end;

procedure TSctRichTextLabel.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('AutoSize', ReadAutoSize, WriteAutoSize, False);
end;

function TSctRichTextLabel.GetDataNow: String;
begin
  Result := DisplayText
end;

procedure TSctRichTextLabel.Print(oPage: TComponent; space: Integer);
var
  pg: TSctPage;
  R: TRect;
Begin
  EndPrint := False;

  if PrintOk then
  begin
    BeforePrint;
    pg := TSctPage(oPage);
    R := Bounds(pg.xPos + left, pg.yPos + top, width, height);
    FirstTime := True;
    Space := Space - Top;

    if FRtfDraw <> nil then FRtfDraw.Free;
    FRtfDraw := TAceRtfDraw.Create;
    FRtfDraw.Reset;
    FRtfDraw.Font := Font;
    FRtfDraw.SetDefaultFont := FSetDefaultFont;
    if Variable <> nil then
    begin
      if Variable.Active then
      begin
        FRtfDraw.LoadFromStream(Variable.AsStream);
      end;
    end;

    PrintLabel(pg.PrintTo.AceCanvas, R, Space);
    AfterPrint;
  end;
  EndPrint := True;
End;

procedure TSctRichTextLabel.PrintTab(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
begin
end;

procedure TSctRichTextLabel.PrintRtf(oPage: TWinControl; rtf: TSctRtfFile; PrintRow: Integer);
Begin
  EndPrint := True;
end;

procedure TSctRichTextLabel.Paint;
var
  AceCanvas: TAceCanvas;
  R: TRect;
begin
  Painting := True;
  AceCanvas := TAceCanvas.Create;
  try
    FirstTime := True;
    AceCanvas.Handle := Canvas.Handle;
    R := Bounds(0, 0, width - 1, height - 1);

    if FRtfDraw <> nil then FRtfDraw.Free;
    FRtfDraw := TAceRtfDraw.Create;
    FRtfDraw.Reset;
    FRtfDraw.Font := Font;
    FRtfDraw.SetDefaultFont := FSetDefaultFont;

    if Variable <> nil then
    begin
      if Not Variable.Initialized then Variable.Initialize;
      if Variable.Active then
      begin
        FRtfDraw.LoadFromStream(Variable.AsStream);
      end;
    end;
    PrintLabel(AceCanvas, R, Height);
  finally
    AceCanvas.free;
    Painting := False;
  end;
end;

function TSctRichTextLabel.PrintMemo( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer): Integer;
var
  Count: LongInt;
  DRect: TRect;
begin
  FRtfDraw.PrintCount := 0;
  FRtfDraw.PixelsPerInchX := PixelsPerInch;
  FRtfDraw.PixelsPerInchY := PixelsPerInch;

  DRect := Bounds(Rect.Left + BorderMargin
                , Rect.Top + BorderMargin
                , Rect.Right-Rect.Left-(BorderMargin*2)
                , Rect.Bottom-Rect.Top-(BorderMargin * 2) - FBottomMargin) ;

  FRtfDraw.Font := Font;
  FRtfDraw.SetDefaultFont := FSetDefaultFont;

  if Stretch then
  begin
    DRect.Bottom := DRect.Top + Space - (BorderMargin * 2) - FBottomMargin;
    FRtfDraw.OutRect := DRect;
    Count := FRtfDraw.PrintCount;
    Result := FRtfDraw.Height + (BorderMargin * 2) + FBottomMargin;
    if (FRtfDraw.Position + Count) >= FRtfDraw.TextLength then EndPrint := True;
    if FirstTime And (Result < Height) then Result := Height;
  end else
  begin
    FRtfDraw.OutRect := DRect;
    EndPrint := True;
    Result := Height;
    Count := FRtfDraw.PrintCount;
  end;

  InitPrint(AceCanvas, Bounds(Rect.left, Rect.Top, width, Result - 1));
  if Variable <> nil then
  begin
    if Variable.Active then
    begin
      AceCanvas.Font := Font;
      AceCanvas.RtfDraw(DRect, Variable.AsStream, FRtfDraw.Position, FRtfDraw.Position + Count, FSetDefaultFont);
      FRtfDraw.Position := FRtfDraw.Position + Count;
    end;
  end;

  if Not Painting then PrintBorder(AceCanvas, Bounds(Rect.Left, Rect.Top, width, Result))
  else PrintBorder(AceCanvas,Rect );
end;


procedure TSctRichTextLabel.PrintLabel( AceCanvas: TAceCanvas; Rect: TRect; Space: Integer);
begin
  PrintMemo(AceCanvas, Rect, Space);
end;

procedure TSctRichTextLabel.StartPrint;
begin
  EndPrint := False;
  if PrintOk then
  begin
    if Not RtfPrint And (TSctPage(Page).Outputtype = otRichText) then EndPrint := True;
    if Not EndPrint then
    begin
      FirstTime := True;

      if Variable <> nil then
      begin
        if FRtfDraw <> nil then FRtfDraw.Free;
        FRtfDraw := TAceRtfDraw.Create;
        FRtfDraw.Reset;
        FRtfDraw.Font := Font;
        FRtfDraw.SetDefaultFont := FSetDefaultFont;
        FRtfDraw.PixelsPerInchX := PixelsPerInch;
        FRtfDraw.PixelsPerInchY := PixelsPerInch;
        FRtfDraw.OutRect := Bounds(100,100, width - (BorderMargin*2), 2000);

        FRtfDraw.LoadFromStream(Variable.AsStream);
      end;
    end;
  end else EndPrint := True;
end;

function TSctRichTextLabel.PrintHeight( oPage: Tcomponent; Space, taking: Integer): Integer;
var
  pg: TSctPage;
  R: TRect;
begin
  if PrintOk then
  begin
    if Variable <> nil Then
    begin
      if FirstTime then BeforePrint;
      pg := TSctPage(oPage);

      if FirstTime then
      begin
        Space := Space - top;
        R := Bounds(pg.xPos + left, pg.yPos + top, width, Space)
      end else R := Bounds(pg.xPos + left, pg.yPos + 1, width, Space);

      Result := PrintMemo( pg.PrintTo.AceCanvas, R, Space);

      { Adjust space taken to add in starting point of label }
      if FirstTime then Result := Result + top;

      if EndPrint then AfterPrint;
      FirstTime := False;
    end else
    begin
      EndPrint := True;
      Result := 0;
    end;
  end else
  begin
    EndPrint := True;
    Result := 0;

  end;
end;

function TSctRichTextLabel.spendheight(oPage: TComponent; Space: Integer): Integer;
begin
  if PrintOk And (Variable <> nil) Then
  begin
    FRtfDraw.PrintCount := 0;
    FRtfDraw.Font := Font;
    FRtfDraw.SetDefaultFont := FSetDefaultFont;
    if Stretch then
    begin

      if FirstTime then
      begin
        if (Space - Top) < Height Then
        begin
          Result := Top + Height;
        end else
        begin
          FRtfDraw.OutRect := Bounds(TSctPage(Parent).xPos + Left + BorderMargin
                     , TSctPage(Parent).yPos + Top + BorderMargin
                     , Width - (BorderMargin * 2)
                     , Space - Top - (BorderMargin * 2) - FBottomMargin);
          FRtfDraw.PrintCount;
          Result := Top + FRtfDraw.Height + (BorderMargin * 2) + FBottomMargin;

          if ((Top + Height) > Result) And ((Top + Height) <= Space) Then Result := Top + Height;
        end;
      end else
      begin
        FRtfDraw.OutRect := Bounds(TSctPage(Parent).xPos + Left + BorderMargin
                   , TSctPage(Parent).yPos + BorderMargin
                   , Width - (BorderMargin * 2)
                   , Space - (BorderMargin * 2) - FBottomMargin);
        FRtfDraw.PrintCount;
        Result := 1 + FRtfDraw.Height + (BorderMargin * 2) + FBottomMargin;

      end;
    end else
    begin
      Result := Top + Height;
    end;
  end else Result := 0;
end;

procedure TSctRichTextLabel.SetVariable(Variable: TSctvar);
begin
  FVariable := Variable;
  Caption := DisplayText;
end;

function TSctRichTextLabel.GetDisplayText: string;
begin
  if Variable <> nil then Result := Variable.Name
  else Result := 'Fill in variable.';
end;

procedure TSctRichTextLabel.Notification(AComponent: TComponent;
      Operation: TOperation);
begin
  Inherited Notification(AComponent, Operation);
  if (AComponent is TSctvar) Then
  begin
    if (Operation = opRemove) And (TSctvar(AComponent) = Variable) Then
      Variable := nil;
  end;

end;


end.