home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_E_CSV.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  4KB  |  164 lines

  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {            CSV export filter             }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_E_CSV;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QForms, QStdCtrls,
  19.   FR_Class, FR_E_TXT, QControls;
  20.  
  21. type
  22.   TfrCSVExport = class(TfrTextExport)
  23.   private
  24.     FDelimiter: WideChar;
  25.   public
  26.     constructor Create(AOwner: TComponent); override;
  27.     function ShowModal: Word; override;
  28.     procedure OnEndPage; override;
  29.   published
  30.     property Delimiter: WideChar read FDelimiter write FDelimiter;
  31.   end;
  32.  
  33.   TfrCSVExportForm = class(TForm)
  34.     GroupBox1: TGroupBox;
  35.     CB1: TCheckBox;
  36.     CB2: TCheckBox;
  37.     Label1: TLabel;
  38.     E1: TEdit;
  39.     Button1: TButton;
  40.     Button2: TButton;
  41.     Label2: TLabel;
  42.     Label3: TLabel;
  43.     E2: TEdit;
  44.     Label4: TLabel;
  45.     E3: TEdit;
  46.     procedure FormCreate(Sender: TObject);
  47.   private
  48.     { Private declarations }
  49.     procedure Localize;
  50.   public
  51.     { Public declarations }
  52.   end;
  53.  
  54. implementation
  55.  
  56. uses FR_Const, FR_Utils;
  57.  
  58. {$R *.xfm}
  59.  
  60.  
  61. { TfrCSVExport }
  62.  
  63. constructor TfrCSVExport.Create(AOwner: TComponent);
  64. begin
  65.   inherited Create(AOwner);
  66.   frRegisterExportFilter(Self, (SCSVFile) + ' (*.csv)', '*.csv');
  67.   ShowDialog := True;
  68.   ScaleX := 1;
  69.   ScaleY := 1;
  70.   KillEmptyLines := True;
  71.   ConvertToOEM := False;
  72.   Delimiter := ';';
  73. end;
  74.  
  75. function TfrCSVExport.ShowModal: Word;
  76. begin
  77.   if not ShowDialog then
  78.     Result := mrOk
  79.   else with TfrCSVExportForm.Create(nil) do
  80.   begin
  81.     CB1.Checked := KillEmptyLines;
  82.     CB2.Checked := ConvertToOEM;
  83.     E1.Text := FloatToStr(ScaleX);
  84.     E2.Text := FloatToStr(ScaleY);
  85.     E3.Text := Delimiter;
  86.  
  87.     Result := ShowModal;
  88.     try
  89.       ScaleX := frStrToFloat(E1.Text);
  90.     except
  91.       ScaleX := 1;
  92.     end;
  93.     try
  94.       ScaleY := frStrToFloat(E2.Text);
  95.     except
  96.       ScaleY := 1;
  97.     end;
  98.     KillEmptyLines := CB1.Checked;
  99.     ConvertToOEM := CB2.Checked;
  100.     if E3.Text <> '' then
  101.       Delimiter := E3.Text[1];
  102.     Free;
  103.   end;
  104. end;
  105.  
  106. procedure TfrCSVExport.OnEndPage;
  107. var
  108.   i, j, n, tc1, tc2: Integer;
  109.   p: PfrTextRec;
  110.   s: String;
  111. begin
  112.   n := Lines.Count - 1;
  113.   while n >= 0 do
  114.   begin
  115.     if Lines[n] <> nil then break;
  116.     Dec(n);
  117.   end;
  118.  
  119.   for i := 0 to n do
  120.   begin
  121.     s := '';
  122.     tc1 := 0;
  123.     p := PfrTextRec(Lines[i]);
  124.     while p <> nil do
  125.     begin
  126.       tc2 := Round(p^.X / (64 / ScaleX));
  127.       for j := 0 to tc2 - tc1 - 1 do
  128.         s := s + Delimiter;
  129.       if Pos(Delimiter, p^.Text) <> 0 then
  130.         s := s + '"' + p^.Text + '"' else
  131.         s := s + p^.Text;
  132.       tc1 := tc2;
  133.       p := p^.Next;
  134.     end;
  135.     if not KillEmptyLines or (s <> '') then
  136.     begin
  137. {      if ConvertToOEM then
  138.         CharToOEMBuff(@s[1], @s[1], Length(s));}
  139.       s := s + #13#10;
  140.       Stream.Write(s[1], Length(s));
  141.     end;
  142.   end;
  143. end;
  144.  
  145.  
  146. procedure TfrCSVExportForm.Localize;
  147. begin
  148.   Caption := S54810;
  149.   CB1.Caption := S54801;
  150.   CB2.Caption := S54802;
  151.   Label1.Caption := S54806;
  152.   Label4.Caption := S54811;
  153.   Button1.Caption := (SOk);
  154.   Button2.Caption := (SCancel);
  155. end;
  156.  
  157. procedure TfrCSVExportForm.FormCreate(Sender: TObject);
  158. begin
  159.   Localize;
  160. end;
  161.  
  162.  
  163. end.
  164.