strdump.pas

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

unit StrDump;

interface

uses
  SysUtils, Classes, 
  BasicExp;

type
  TStringDump = class(TComponent)
  private
    { Private declarations }

    FExporter   : TAbstractExporter;

    Table       : Boolean;

    Procedure   GetStyles(Var S:String;Var A:TExpAlign;Var Fs:TExpFontSize;Var FSt:TExpFontStyle);
    Procedure   DumpParagraph(S:String);
    Procedure   DumpTableRow(S:String);
    Procedure   DumpTableCell(S:String);
  protected
    { Protected declarations }
  public
    { Public declarations }
    Procedure   Open;
    Procedure   Close;
    Procedure   Dump(S:String);
  published
    { Published declarations }

    Property    Exporter   : TAbstractExporter  Read FExporter   Write FExporter;
  end;

procedure Register;

implementation

Uses Strings1;

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

Procedure   TStringDump.GetStyles(Var S:String;Var A:TExpAlign;Var Fs:TExpFontSize;Var FSt:TExpFontStyle);
   Var M : String;
   Begin
      M:=ExtractMacro(S,'{','}');
      A:=REAlignNone;
      If Pos('L',M) <> 0 Then A:=REAlignLeft;
      If Pos('R',M) <> 0 Then A:=REAlignRight;
      If Pos('C',M) <> 0 Then A:=REAlignCenter;
      If Pos('J',M) <> 0 Then A:=REAlignJust;

      Fs:=10;
      If Pos('1',M) <> 0 Then Fs:=1;
      If Pos('2',M) <> 0 Then Fs:=2;
      If Pos('3',M) <> 0 Then Fs:=3;
      If Pos('4',M) <> 0 Then Fs:=4;
      If Pos('5',M) <> 0 Then Fs:=5;
      If Pos('6',M) <> 0 Then Fs:=6;
      If Pos('7',M) <> 0 Then Fs:=7;
      If Pos('8',M) <> 0 Then Fs:=8;
      If Pos('9',M) <> 0 Then Fs:=9;
      If Pos('0',M) <> 0 Then Fs:=10;

      FSt:=[];
      If Pos('B',M) <> 0 Then FSt:=FSt + [REBold];
      If Pos('I',M) <> 0 Then FSt:=FSt + [REItalic];
      If Pos('U',M) <> 0 Then FSt:=FSt + [REUnderline];
      If Pos('T',M) <> 0 Then FSt:=FSt + [RETeletype];
   End;

Procedure TStringDump.Open;
   Begin
      If AsSigned(FExporter) Then
         FExporter.Open;
      Table:=False;
   End;

Procedure TStringDump.Close;
   Begin
      If AsSigned(FExporter) Then
         Begin
            If Table Then
               FExporter.EndTable;
             FExporter.Close;
         End;
     End;

Procedure TStringDump.Dump(S:String);
   Var TT  : Boolean;
   Begin
      If Not AsSigned(FExporter) Then Exit;

      TT:=ExistMacro(S,'<*T*>');

      If (TT) And Not(Table) Then
         Begin
            FExporter.BeginTable(1);
            Table:=True;
         End;
      If Not(TT) And (Table) Then
         Begin
            FExporter.EndTable;
            Table:=False;
         End;

      If Table Then
         DumpTableRow(S)
      Else
         DumpParagraph(S);
   End;

Procedure TStringDump.DumpParagraph(S:String);
   Var A   : TExpAlign;
       FS  : TExpFontSize;
       FSt : TExpFontStyle;
   Begin
      GetStyles(S,A,Fs,Fst);

      While ExistMacro(S,'<*I+*>') Do
         FExporter.IndentPlus;

      While ExistMacro(S,'<*I-*>') Do
         FExporter.IndentMinus;

      FExporter.QuickParagraph(S,A,Fs,Fst);
   End;

Procedure TStringDump.DumpTableRow(S:String);
   Var S1 : String;
       I  : Integer;
   Begin
      FExporter.BeginRow;

      S1:='';
      For I:=1 To Length(S) Do
         If S[I] <> #9 Then
            S1:=S1 + S[I]
         Else
            Begin
               DumpTableCell(S1);
               S1:='';
            End;
      If (S1 <> ''         ) Or
         (S[Length(S)] = #9) Then
         DumpTableCell(S1);

      FExporter.EndRow;
   End;

Procedure TStringDump.DumpTableCell(S:String);
   Var A   : TExpAlign;
       FS  : TExpFontSize;
       FSt : TExpFontStyle;
   Begin
      GetStyles(S,A,Fs,Fst);
      FExporter.Cell(S,A,Fs,Fst);
   End;

end.