rtfexp.pas

此控件可将数据表转换成多种格式:文本,HTML,RTF

{
RTF Exporter Component
Version 0.1 Beta Free

Copyright 12.1997 By MAD Soft

Telephone: Bulgaria, Sofia, 37-06-23
E_Mail:    [e-mail]
           [e-mail]
Web:       Http:\\WWW.NSI.BG\NMMM\Home.Htm

Notes:
   This is absolutely free component.
   It Support only paragraph, aligment and tabs.
}

Unit Rtfexp;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, BasicExp;

type
  TRTFExporterBeta = class(TAbstractExporter)
  private
    { Private declarations }
    FFont        : String;

    Procedure OutputStr(S : String);
  protected
    { Protected declarations }
  public
    { Public declarations }
    Constructor Create(AOwner:TComponent); OverRide;

    Procedure Open; OverRide;
    Procedure Close; OverRide;

    Procedure BeginParagraph(Align:TExpAlign;FontSize:TExpFontSize;FontStyle:TExpFontStyle); OverRide;
    Procedure Paragraph(S:String); OverRide;
    Procedure EndParagraph; OverRide;
  published
    Property Font        : String     Read FFont        Write FFont;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Exporter', [TRTFExporterBeta]);
end;

Constructor TRTFExporterBeta.Create(AOwner:TComponent);
   Begin
      Inherited Create(AOwner);

      FFont:='Arial';
   End;

Procedure TRTFExporterBeta.Open;
   Begin
      Inherited Open;

      OutPutLn('{\rtf1\ansi{\fonttbl{' + FFont + '}}');
   End;

Procedure TRTFExporterBeta.Close;
   Begin
      OutPutLn('}');

      Inherited Close;
   End;

Procedure TRTFExporterBeta.BeginParagraph(Align:TExpAlign;FontSize:TExpFontSize;FontStyle:TExpFontStyle);
   Begin
      OutPut('\pard');

      Case Align Of
         REAlignRight   : OutPut('\qr');
         REAlignCenter  : OutPut('\qc');
         REAlignJust    : OutPut('\qj');
      Else
         OutPut('\ql');
      End;{CASE}

      OutPut(' ');
   End;

Procedure TRTFExporterBeta.Paragraph(S:String);
   Begin
      OutPutStr(S);
   End;

Procedure TRTFExporterBeta.EndParagraph;
   Begin
      OutPutLn('\par');
   End;

Procedure TRTFExporterBeta.OutPutStr(S : String);
   Var I  : Byte;
   Begin
      If Length(S) > 0 Then
         For I:=1 To Length(S) Do
            Case S[I] Of
               '{':OutPut('\{');    
               '}':OutPut('\}');
               #9 :OutPut('\tab ');
            Else
               OutPut('' + S[I]);
            End;{Case}
   End;

end.