home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_E_TXT.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  11KB  |  435 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {           Text export filter             }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_E_TXT;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QForms, QDialogs, FR_Class,
  19.   QStdCtrls, QControls;
  20.  
  21. type
  22.   TfrTextExport = class(TfrExportFilter)
  23.   protected
  24.     FScaleX, FScaleY: Double;
  25.     FKillEmptyLines, FConvertToOEM, FExportFrames,
  26.     FUsePseudographic, FPageBreaks: Boolean;
  27.     Strings: TStringList;
  28.   public
  29.     constructor Create(AOwner: TComponent); override;
  30.     destructor Destroy; override;
  31.     function ShowModal: Word; override;
  32.     procedure OnEndPage; override;
  33.     procedure OnBeginPage; override;
  34.     procedure OnText(DrawRect: TRect; X, Y: Integer; const Text: String;
  35.       FrameTyp: Integer; View: TfrView); override;
  36.     procedure InsertTextRec(p: PfrTextRec; LineIndex: Integer);
  37.   published
  38.     property ScaleX: Double read FScaleX write FScaleX;
  39.     property ScaleY: Double read FScaleY write FScaleY;
  40.     property KillEmptyLines: Boolean read FKillEmptyLines write FKillEmptyLines default True;
  41.     property ConvertToOEM: Boolean read FConvertToOEM write FConvertToOEM default False;
  42.     property ExportFrames: Boolean read FExportFrames write FExportFrames default False;
  43.     property UsePseudographic: Boolean read FUsePseudographic write FUsePseudographic default False;
  44.     property PageBreaks: Boolean read FPageBreaks write FPageBreaks default True;
  45.   end;
  46.  
  47.   TfrTXTExportForm = class(TForm)
  48.     GroupBox1: TGroupBox;
  49.     CB1: TCheckBox;
  50.     CB2: TCheckBox;
  51.     CB4: TCheckBox;
  52.     Label1: TLabel;
  53.     E1: TEdit;
  54.     Button1: TButton;
  55.     Button2: TButton;
  56.     CB5: TCheckBox;
  57.     CB3: TCheckBox;
  58.     Label2: TLabel;
  59.     Label3: TLabel;
  60.     E2: TEdit;
  61.     procedure CB3Click(Sender: TObject);
  62.     procedure FormCreate(Sender: TObject);
  63.   private
  64.     { Private declarations }
  65.     procedure Localize;
  66.   public
  67.     { Public declarations }
  68.   end;
  69.  
  70. implementation
  71.  
  72. uses FR_Utils, FR_Const;
  73.  
  74. {$R *.xfm}
  75.  
  76. const
  77.   Frames = '|-+++++++++';
  78.   Pseudo = #179#196#218#191#192#217#193#195#194#180#197;
  79.   PseudoHex = #5#10#6#12#3#9#11#7#14#13#15;
  80.  
  81.  
  82. { TfrTextExport }
  83.  
  84. constructor TfrTextExport.Create(AOwner: TComponent);
  85. begin
  86.   inherited Create(AOwner);
  87.   if ClassName = 'TfrTextExport' then
  88.     frRegisterExportFilter(Self, STextFile + ' (*.txt)', '*.txt');
  89.   Strings := TStringList.Create;
  90.   ShowDialog := True;
  91.   ScaleX := 1;
  92.   ScaleY := 1;
  93.   KillEmptyLines := True;
  94.   ConvertToOEM := False;
  95.   ExportFrames := False;
  96.   UsePseudographic := False;
  97.   PageBreaks := True;
  98. end;
  99.  
  100. destructor TfrTextExport.Destroy;
  101. begin
  102.   Strings.Free;
  103.   frUnRegisterExportFilter(Self);
  104.   inherited Destroy;
  105. end;
  106.  
  107. function TfrTextExport.ShowModal: Word;
  108. begin
  109.   if not ShowDialog then
  110.     Result := mrOk
  111.   else with TfrTXTExportForm.Create(nil) do
  112.   begin
  113.     CB1.Checked := KillEmptyLines;
  114.     CB2.Checked := ConvertToOEM;
  115.     CB3.Checked := ExportFrames;
  116.     CB4.Checked := UsePseudoGraphic;
  117.     CB5.Checked := PageBreaks;
  118.     E1.Text := FloatToStr(ScaleX);
  119.     E2.Text := FloatToStr(ScaleY);
  120.     CB3Click(nil);
  121.     Result := ShowModal;
  122.     try
  123.       ScaleX := frStrToFloat(E1.Text);
  124.     except
  125.       ScaleX := 1;
  126.     end;
  127.     try
  128.       ScaleY := frStrToFloat(E2.Text);
  129.     except
  130.       ScaleY := 1;
  131.     end;
  132.     KillEmptyLines := CB1.Checked;
  133.     ConvertToOEM := CB2.Checked;
  134.     ExportFrames := CB3.Checked;
  135.     UsePseudoGraphic := CB4.Checked;
  136.     PageBreaks := CB5.Checked;
  137.     Free;
  138.   end;
  139. end;
  140.  
  141. procedure TfrTextExport.OnEndPage;
  142. var
  143.   i, n, x, dx, x1, dx1, tc1: Integer;
  144.   p: PfrTextRec;
  145.   s: String;
  146.   AddIndex: Integer;
  147.   IsEmpty: Boolean;
  148.  
  149.   function Dup(Count: Integer): String;
  150.   var
  151.     i: Integer;
  152.   begin
  153.     Result := '';
  154.     for i := 1 to Count do
  155.       Result := Result + ' ';
  156.   end;
  157.  
  158.   procedure CheckLine(Index: Integer);
  159.   var
  160.     i: Integer;
  161.     s: String;
  162.   begin
  163.     s := Strings[Index];
  164.     for i := 1 to Length(s) do
  165.     begin
  166.       if (Pos(s[i], PseudoHex) = 0) and (s[i] <> ' ') then
  167.       begin
  168.         Strings.Add('');
  169.         AddIndex := Strings.Count;
  170.         break;
  171.       end;
  172.     end;
  173.   end;
  174.  
  175.   procedure FillLine(Index, x, dx: Integer; ch: Integer);
  176.   var
  177.     i, n: Integer;
  178.     s: String;
  179.   begin
  180.     s := Strings[Index];
  181.     if Length(s) < x + dx then
  182.       s := s + Dup(x + dx - Length(s));
  183.     for i := x to x + dx - 1 do
  184.     begin
  185.       n := Pos(s[i], PseudoHex);
  186.       if n = 0 then
  187.         s[i] := PseudoHex[ch] else
  188.         s[i] := Chr(Ord(PseudoHex[n]) or Ord(PseudoHex[ch]));
  189.     end;
  190.     Strings[Index] := s;
  191.   end;
  192.  
  193.   procedure AddLine(s: String);
  194.   var
  195.     i: Integer;
  196.     s1: String;
  197.   begin
  198.     if AddIndex >= Strings.Count then
  199.       Strings.Add(s)
  200.     else
  201.     begin
  202.       s1 := Strings[AddIndex];
  203.       if Length(s) > Length(s1) then
  204.         s1 := s1 + Dup(Length(s) - Length(s1));
  205.       for i := 1 to Length(s) do
  206.         if s1[i] = ' ' then
  207.           s1[i] := s[i];
  208.       Strings[AddIndex] := s1;
  209.     end;
  210.   end;
  211.  
  212.   function ReplaceFrames(s: String): String;
  213.   var
  214.     i, n: Integer;
  215.   begin
  216.     for i := 1 to Length(s) do
  217.     begin
  218.       n := Pos(s[i], PseudoHex);
  219.       if n <> 0 then
  220.         if UsePseudoGraphic then
  221.           s[i] := Pseudo[n] else
  222.           s[i] := Frames[n];
  223.     end;
  224.     Result := s;
  225.   end;
  226.  
  227. begin
  228.   n := Lines.Count - 1;
  229.   while n >= 0 do
  230.   begin
  231.     if Lines[n] <> nil then break;
  232.     Dec(n);
  233.   end;
  234.  
  235.   Strings.Clear;
  236.   for i := 0 to n do
  237.   begin
  238.     s := '';
  239.     tc1 := 0;
  240.     p := PfrTextRec(Lines[i]);
  241.     AddIndex := Strings.Count;
  242.     IsEmpty := True;
  243.     while p <> nil do
  244.     begin
  245.       IsEmpty := False;
  246.       x := Round(p^.X / (6.5 / ScaleX));
  247.       s := s + Dup(x - tc1) + p^.Text;
  248.       tc1 := x + Length(p^.Text);
  249.       if ExportFrames and (p^.FrameTyp <> 0) then
  250.       begin
  251.         x1 := Round(p^.DrawRect.Left / (6.5 / ScaleX));
  252.         dx1 := Round(p^.DrawRect.Right / (6.5 / ScaleX)) - x1 + 1;
  253.         if ((p^.FrameTyp and frftTop) <> 0) or
  254.            ((p^.FrameTyp and frftBottom) <> 0) then
  255.         begin
  256.           if (p^.FrameTyp and frftTop) <> 0 then
  257.             if Strings.Count = 0 then
  258.             begin
  259.               Strings.Add('');
  260.               AddIndex := 1;
  261.             end
  262.             else
  263.               CheckLine(AddIndex - 1);
  264.  
  265.           x := x1; dx := dx1;
  266.           if (p^.FrameTyp and frftTop) <> 0 then
  267.           begin
  268.             if (p^.FrameTyp and frftLeft) <> 0 then
  269.             begin
  270.               FillLine(AddIndex - 1, x, 1, 3);
  271.               Inc(x); Dec(dx);
  272.             end;
  273.             if (p^.FrameTyp and frftRight) <> 0 then
  274.             begin
  275.               FillLine(AddIndex - 1, x + dx - 1, 1, 4);
  276.               Dec(dx);
  277.             end;
  278.             FillLine(AddIndex - 1, x, dx, 2);
  279.           end;
  280.  
  281.           x := x1; dx := dx1;
  282.           if (p^.FrameTyp and frftBottom) <> 0 then
  283.           begin
  284.             if AddIndex = Strings.Count then
  285.             begin
  286.               Strings.Add('');
  287.               AddIndex := Strings.Count - 1;
  288.               Strings.Add('');
  289.             end
  290.             else
  291.             if AddIndex = Strings.Count - 1 then
  292.               Strings.Add('');
  293.  
  294.             if (p^.FrameTyp and frftLeft) <> 0 then
  295.             begin
  296.               FillLine(AddIndex + 1, x, 1, 5);
  297.               Inc(x); Dec(dx);
  298.             end;
  299.             if (p^.FrameTyp and frftRight) <> 0 then
  300.             begin
  301.               FillLine(AddIndex + 1, x + dx - 1, 1, 6);
  302.               Dec(dx);
  303.             end;
  304.             FillLine(AddIndex + 1, x, dx, 2);
  305.           end;
  306.         end;
  307.  
  308.         x := x1; dx := dx1;
  309.         if ((p^.FrameTyp and frftLeft) <> 0) or
  310.            ((p^.FrameTyp and frftRight) <> 0) then
  311.         begin
  312.           if AddIndex >= Strings.Count then
  313.           begin
  314.             Strings.Add('');
  315.             AddIndex := Strings.Count - 1;
  316.           end;
  317.           if (p^.FrameTyp and frftLeft) <> 0 then
  318.             FillLine(AddIndex, x, 1, 1);
  319.           if (p^.FrameTyp and frftRight) <> 0 then
  320.             FillLine(AddIndex, x + dx - 1, 1, 1);
  321.         end;
  322.       end;
  323.       p := p^.Next;
  324.     end;
  325.     if not KillEmptyLines or not IsEmpty then
  326.       AddLine(s);
  327.   end;
  328.   if PageBreaks then
  329.   begin
  330.     s := #12;
  331.     Strings.Add(s);
  332.   end;
  333.  
  334.   for i := 0 to Strings.Count - 1 do
  335.   begin
  336.     s := Strings[i];
  337. {    if ConvertToOEM then
  338.       CharToOEMBuff(@s[1], @s[1], Length(s));}
  339.     if s <> #12 then
  340.       s := ReplaceFrames(s) + #13#10 else
  341.       s := s + #13#10;
  342.     Stream.Write(s[1], Length(s));
  343.   end;
  344. end;
  345.  
  346. procedure TfrTextExport.OnBeginPage;
  347. var
  348.   i: Integer;
  349. begin
  350.   ClearLines;
  351.   for i := 0 to 200 do Lines.Add(nil);
  352. end;
  353.  
  354. procedure TfrTextExport.InsertTextRec(p: PfrTextRec; LineIndex: Integer);
  355. var
  356.   p1, p2: PfrTextRec;
  357. begin
  358.   p1 := PfrTextRec(Lines[LineIndex]);
  359.   p^.Next := nil;
  360.   if p1 = nil then
  361.     Lines[LineIndex] := TObject(p)
  362.   else
  363.   begin
  364.     p2 := p1;
  365.     while (p1 <> nil) and (p1^.X < p^.X) do
  366.     begin
  367.       p2 := p1;
  368.       p1 := p1^.Next;
  369.     end;
  370.     if p2 <> p1 then
  371.     begin
  372.       p2^.Next := p;
  373.       p^.Next := p1;
  374.     end
  375.     else
  376.     begin
  377.       Lines[LineIndex] := TObject(p);
  378.       p^.Next := p1;
  379.     end;
  380.   end;
  381. end;
  382.  
  383. procedure TfrTextExport.OnText(DrawRect: TRect; X, Y: Integer;
  384.   const Text: String; FrameTyp: Integer; View: TfrView);
  385. var
  386.   p: PfrTextRec;
  387. begin
  388.   if View = nil then Exit;
  389.   Y := Round(Y / (14 / ScaleY));
  390.   New(p);
  391.   p^.X := X;
  392.   p^.Text := Text;
  393.   if View is TfrMemoView then
  394.     with View as TfrMemoView do
  395.     begin
  396.       p^.FontName := Font.Name;
  397.       p^.FontSize := Font.Size;
  398.       p^.FontStyle := frGetFontStyle(Font.Style);
  399.       p^.FontColor := Font.Color;
  400.       p^.FontCharset := Integer(Font.Charset);
  401.     end;
  402.   p^.DrawRect := DrawRect;
  403.   p^.FrameTyp := FrameTyp;
  404.   p^.FillColor := View.FillColor;
  405.   InsertTextRec(p, Y);
  406. end;
  407.  
  408.  
  409.  
  410. procedure TfrTXTExportForm.CB3Click(Sender: TObject);
  411. begin
  412.   CB4.Enabled := CB3.Checked;
  413. end;
  414.  
  415. procedure TfrTXTExportForm.Localize;
  416. begin
  417.   Caption := S54800;
  418.   CB1.Caption := S54801;
  419.   CB2.Caption := S54802;
  420.   CB3.Caption := S54803;
  421.   CB4.Caption := S54804;
  422.   CB5.Caption := S54805;
  423.   Label1.Caption := S54806;
  424.   Button1.Caption := (SOk);
  425.   Button2.Caption := (SCancel);
  426. end;
  427.  
  428. procedure TfrTXTExportForm.FormCreate(Sender: TObject);
  429. begin
  430.   Localize;
  431. end;
  432.  
  433.  
  434. end.
  435.