/Source/FR_E_TXT.PAS

  1
  2{*****************************************}
  3{                                         }
  4{             FastReport v2.3             }
  5{           Text export filter            }
  6{                                         }
  7{  Copyright (c) 1998-99 by Tzyganenko A. }
  8{                                         }
  9{*****************************************}
 10
 11unit FR_E_TXT;
 12
 13interface
 14
 15{$I FR.inc}
 16
 17uses
 18  SysUtils, Windows, Messages, Classes, Graphics, Dialogs, FR_Class;
 19
 20type
 21  TfrTextExport = class(TComponent) // fake component
 22  end;
 23
 24  TfrTextExportFilter = class(TfrExportFilter)
 25  public
 26    constructor Create(AStream: TStream); override;
 27    procedure OnEndPage; override;
 28    procedure OnBeginPage; override;
 29    procedure OnText(X, Y: Integer; const Text: String; View: TfrView); override;
 30  end;
 31
 32
 33implementation
 34
 35uses FR_Utils, FR_Const;
 36
 37
 38var
 39  UsedFont: Integer = 16;
 40
 41constructor TfrTextExportFilter.Create(AStream: TStream);
 42var
 43  s: String;
 44  n: Integer;
 45begin
 46  inherited;
 47  s := InputBox(LoadStr(SFilter), LoadStr(SFilterParam), '16');
 48  Val(s, UsedFont, n);
 49end;
 50
 51procedure TfrTextExportFilter.OnEndPage;
 52var
 53  i, n, x, tc1: Integer;
 54  p: PfrTextRec;
 55  s: String;
 56  function Dup(Count: Integer): String;
 57  var
 58    i: Integer;
 59  begin
 60    Result := '';
 61    for i := 1 to Count do
 62      Result := Result + ' ';
 63  end;
 64
 65begin
 66  n := Lines.Count - 1;
 67  while n >= 0 do
 68  begin
 69    if Lines[n] <> nil then break;
 70    Dec(n);
 71  end;
 72
 73  for i := 0 to n do
 74  begin
 75    s := '';
 76    tc1 := 0;
 77    p := PfrTextRec(Lines[i]);
 78    while p <> nil do
 79    begin
 80      x := Round(p^.X / 6.5);
 81      s := s + Dup(x - tc1) + p^.Text;
 82      tc1 := x + Length(p^.Text);
 83      p := p^.Next;
 84    end;
 85    s := s + #13#10;
 86    Stream.Write(s[1], Length(s));
 87  end;
 88  s := #12#13#10;
 89  Stream.Write(s[1], Length(s));
 90end;
 91
 92procedure TfrTextExportFilter.OnBeginPage;
 93var
 94  i: Integer;
 95begin
 96  ClearLines;
 97  for i := 0 to 200 do Lines.Add(nil);
 98end;
 99
100procedure TfrTextExportFilter.OnText(X, Y: Integer; const Text: String;
101  View: TfrView);
102var
103  p, p1, p2: PfrTextRec;
104begin
105  if View = nil then Exit;
106  Y := Round(Y / UsedFont);
107  p1 := PfrTextRec(Lines[Y]);
108  GetMem(p, SizeOf(TfrTextRec));
109  FillChar(p^, SizeOf(TfrTextRec), 0);
110  p^.Next := nil;
111  p^.X := X;
112  p^.Text := Text;
113  if View is TfrMemoView then
114    with View as TfrMemoView do
115    begin
116      p^.FontName := Font.Name;
117      p^.FontSize := Font.Size;
118      p^.FontStyle := frGetFontStyle(Font.Style);
119      p^.FontColor := Font.Color;
120{$IFNDEF Delphi2}
121      p^.FontCharset := Font.Charset;
122{$ENDIF}
123    end;
124  p^.FillColor := View.FillColor;
125  if p1 = nil then
126    Lines[Y] := TObject(p)
127  else
128  begin
129    p2 := p1;
130    while (p1 <> nil) and (p1^.X < p^.X) do
131    begin
132      p2 := p1;
133      p1 := p1^.Next;
134    end;
135    if p2 <> p1 then
136    begin
137      p2^.Next := p;
138      p^.Next := p1;
139    end
140    else
141    begin
142      Lines[Y] := TObject(p);
143      p^.Next := p1;
144    end;
145  end;
146end;
147
148
149initialization
150  frRegisterExportFilter(TfrTextExportFilter, LoadStr(STextFile) + ' (*.txt)', '*.txt');
151
152end.