Subversion Repositories delphiutils

Rev

Rev 89 | Rev 91 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit AsciiTable;
  2.  
  3. (*
  4.  * ASCII Table and CSV Generator Delphi Unit
  5.  * Revision 2022-07-09
  6.  *
  7.  * (C) 2022 Daniel Marschall, HickelSOFT, ViaThinkSoft
  8.  * Licensed under the terms of Apache 2.0
  9.  *)
  10.  
  11. {
  12.  
  13. Example usage:
  14.  
  15. uses
  16.   AsciiTable, ContNrs;
  17.  
  18. procedure TForm1.Button1Click(Sender: TObject);
  19. var
  20.   VirtTable: TVtsAsciiTable;
  21.   objLine: TVtsAsciiTableLine;
  22. begin
  23.   VirtTable := TVtsAsciiTable.Create(true);
  24.   VirtTable.Clear;
  25.  
  26.   // Create Test data
  27.   objLine := TVtsAsciiTableLine.Create;
  28.   objLine.SetVal(0, 'Fruit', taCenter);
  29.   objLine.SetVal(1, 'Amount', taCenter);
  30.   VirtTable.Add(objLine);
  31.  
  32.   VirtTable.AddSeparator;
  33.  
  34.   objLine := TVtsAsciiTableLine.Create;
  35.   objLine.SetVal(0, 'Apple', taLeftJustify);
  36.   objLine.SetVal(1, '123', taRightJustify);
  37.   VirtTable.Add(objLine);
  38.  
  39.   objLine := TVtsAsciiTableLine.Create;
  40.   objLine.SetVal(0, 'Kiwi', taLeftJustify);
  41.   objLine.SetVal(1, '1', taRightJustify);
  42.   VirtTable.Add(objLine);
  43.  
  44.   objLine := TVtsAsciiTableLine.Create;
  45.   objLine.SetVal(0, 'Asparagus (green)', taLeftJustify);
  46.   objLine.SetVal(1, '9999', taRightJustify);
  47.   VirtTable.Add(objLine);
  48.  
  49.   objLine := TVtsAsciiTableLine.Create;
  50.   objLine.SetVal(0, 'Asparagus (white)', taLeftJustify);
  51.   objLine.SetVal(1, '999', taRightJustify);
  52.   VirtTable.Add(objLine);
  53.  
  54.   // Create ASCII table
  55.   Memo1.Clear;
  56.   VirtTable.GetASCIITable(Memo1.Lines);
  57.  
  58.   // Save ASCII table
  59.   VirtTable.SaveASCIITable('Order.txt');
  60.  
  61.   // Create CSV
  62.   Memo2.Clear;
  63.   VirtTable.GetCSV(Memo2.Lines);
  64.  
  65.   // Save CSV
  66.   VirtTable.SaveCSV('Order.csv');
  67.  
  68.   VirtTable.Free;
  69. end;
  70.  
  71. }
  72.  
  73. interface
  74.  
  75. uses
  76.   ContNrs, Classes, SysUtils;
  77.  
  78. const
  79.   VTS_ASCII_TABLE_COLS = 10;
  80.  
  81. type
  82.   TVtsAsciiTableLine = class(TObject)
  83.   public
  84.     Cont: array[0..VTS_ASCII_TABLE_COLS-1] of string;
  85.     Align: array[0..VTS_ASCII_TABLE_COLS-1] of TAlignment;
  86.     PadChar: array[0..VTS_ASCII_TABLE_COLS-1] of char;
  87.     procedure Clear;
  88.     procedure SetVal(index: integer; ACont: string; AAlign: TAlignment=taLeftJustify; APadChar: char=' ');
  89.   end;
  90.  
  91.   TVtsAsciiTableAnalysis = record
  92.     MaxLen: array[0..VTS_ASCII_TABLE_COLS-1] of integer;
  93.     Used: array[0..VTS_ASCII_TABLE_COLS-1] of boolean;
  94.     Width: integer;
  95.   end;
  96.  
  97.   TVtsAsciiTable = class(TObjectList{<TVtsAsciiTableLine>})
  98.   private
  99.     function GetItem(Index: Integer): TVtsAsciiTableLine;
  100.     procedure SetItem(Index: Integer; const Value: TVtsAsciiTableLine);
  101.   public
  102.     function GetAnalysis: TVtsAsciiTableAnalysis;
  103.     procedure GetASCIITable(sl: TStrings; spaceBetween: integer=3);
  104.     procedure SaveASCIITable(filename: string; spaceBetween: integer=3);
  105.     procedure GetCSV(sl: TStrings);
  106.     procedure SaveCSV(filename: string);
  107.  
  108.     procedure AddSeparator;
  109.  
  110.     // Just a little bit type-safe... The rest stays TObject for now
  111.     function Add(AObject: TVtsAsciiTableLine): Integer; reintroduce;
  112.     property Items[Index: Integer]: TVtsAsciiTableLine read GetItem write SetItem;
  113.     procedure Insert(Index: Integer; AObject: TVtsAsciiTableLine); reintroduce;
  114.   end;
  115.  
  116. implementation
  117.  
  118. { TVtsAsciiTable }
  119.  
  120. function TVtsAsciiTable.Add(AObject: TVtsAsciiTableLine): Integer;
  121. begin
  122.   result := Inherited Add(AObject);
  123. end;
  124.  
  125. procedure TVtsAsciiTable.AddSeparator;
  126. begin
  127.   Inherited Add(nil);
  128. end;
  129.  
  130. function TVtsAsciiTable.GetAnalysis: TVtsAsciiTableAnalysis;
  131. var
  132.   j: Integer;
  133.   i: Integer;
  134.   objLine: TVtsAsciiTableLine;
  135.   len: Integer;
  136. begin
  137.   for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  138.   begin
  139.     result.MaxLen[j] := 0;
  140.     result.Used[j] := false;
  141.   end;
  142.   for i := 0 to Self.Count-1 do
  143.   begin
  144.     objLine := Self.items[i] as TVtsAsciiTableLine;
  145.     if objLine <> nil then
  146.     begin
  147.       for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  148.       begin
  149.         len := Length(objLine.Cont[j]);
  150.         if len > result.MaxLen[j] then
  151.           result.MaxLen[j] := len;
  152.         if len > 0 then
  153.           result.Used[j] := true;
  154.       end;
  155.     end;
  156.   end;
  157. end;
  158.  
  159. procedure TVtsAsciiTable.GetASCIITable(sl: TStrings; spaceBetween: integer=3);
  160. var
  161.   analysis: TVtsAsciiTableAnalysis;
  162.   objLine: TVtsAsciiTableLine;
  163.   i: Integer;
  164.   sLine: string;
  165.   j: Integer;
  166.   itmp: Integer;
  167.   padchar: Char;
  168.   firstcol: boolean;
  169.   width: Integer;
  170. begin
  171.   analysis := GetAnalysis;
  172.   //sl.Clear;
  173.   for i := 0 to Self.Count-1 do
  174.   begin
  175.     objLine := Self.items[i] as TVtsAsciiTableLine;
  176.     sLine := '';
  177.     if objLine <> nil then
  178.     begin
  179.       firstcol := true;
  180.       for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  181.       begin
  182.         if not analysis.Used[j] then continue;
  183.  
  184.         padchar := objLine.PadChar[j];
  185.         if padchar = #0 then padchar := ' ';
  186.  
  187.         if firstcol then
  188.           firstcol := false
  189.         else
  190.           sLine := sLine + StringOfChar(' ', spaceBetween);
  191.  
  192.         if objLine.Align[j] = taRightJustify then
  193.         begin
  194.           sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));
  195.           sLine := sLine + objLine.Cont[j];
  196.         end
  197.         else if objLine.Align[j] = taLeftJustify then
  198.         begin
  199.           sLine := sLine + objLine.Cont[j];
  200.           sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));
  201.         end
  202.         else if objLine.Align[j] = taCenter then
  203.         begin
  204.           if Odd(analysis.MaxLen[j]-Length(objLine.Cont[j])) then itmp := 1 else itmp := 0;
  205.           sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2);
  206.           sLine := sLine + objLine.Cont[j];
  207.           sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2 + itmp);
  208.         end
  209.         else
  210.           Assert(false);
  211.       end;
  212.     end
  213.     else
  214.     begin
  215.       firstcol := true;
  216.       width := 0;
  217.       for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  218.       begin
  219.         if not analysis.Used[j] then continue;
  220.         if firstcol then
  221.           firstcol := false
  222.         else
  223.           width := width + spaceBetween;
  224.         width := width + analysis.MaxLen[j];
  225.       end;
  226.  
  227.       sLine := sLine + StringOfChar('-', Width);
  228.     end;
  229.     sl.Add(sLine);
  230.   end;
  231. end;
  232.  
  233. function CsvQuoteStr(s: string): string;
  234. begin
  235.   s := StringReplace(s, #13#10, ' ', [rfReplaceAll]);
  236.   s := StringReplace(s, #13, ' ', [rfReplaceAll]);
  237.   s := StringReplace(s, #10, ' ', [rfReplaceAll]);
  238.   if s = '' then
  239.     result := ''
  240.   else if (AnsiPos('"', s)>0) or (AnsiPos('''', s)>0) or (AnsiPos(';', s)>0) or
  241.           (AnsiPos(#9, s)>0) or (AnsiPos(' ', s)>0) then
  242.     result := '"' + StringReplace(s, '"', '""', [rfReplaceAll]) + '"'
  243.   else
  244.     result := s;
  245. end;
  246.  
  247. procedure TVtsAsciiTable.GetCSV(sl: TStrings);
  248. var
  249.   analysis: TVtsAsciiTableAnalysis;
  250.   objLine: TVtsAsciiTableLine;
  251.   i: Integer;
  252.   sLine: string;
  253.   j: Integer;
  254.   firstcol: boolean;
  255. begin
  256.   analysis := GetAnalysis;
  257.   //sl.Clear;
  258.   for i := 0 to Self.Count-1 do
  259.   begin
  260.     objLine := Self.items[i] as TVtsAsciiTableLine;
  261.     if objLine = nil then continue;
  262.     sLine := '';
  263.     firstcol := true;
  264.     for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  265.     begin
  266.       if not analysis.Used[j] then continue;
  267.       if firstcol then
  268.         firstcol := false
  269.       else
  270.         sLine := sLine + ';';
  271.       sLine := sLine + CsvQuoteStr(objLine.Cont[j]);
  272.     end;
  273.     sl.Add(sLine);
  274.   end;
  275. end;
  276.  
  277. function TVtsAsciiTable.GetItem(Index: Integer): TVtsAsciiTableLine;
  278. begin
  279.   result := (Inherited Items[Index]) as TVtsAsciiTableLine;
  280. end;
  281.  
  282. procedure TVtsAsciiTable.Insert(Index: Integer; AObject: TVtsAsciiTableLine);
  283. begin
  284.   Inherited Insert(Index, AObject);
  285. end;
  286.  
  287. procedure TVtsAsciiTable.SaveASCIITable(filename: string;
  288.   spaceBetween: integer);
  289. var
  290.   sl: TStringList;
  291. begin
  292.   sl := TStringList.Create;
  293.   try
  294.     GetASCIITable(sl, spaceBetween);
  295.     sl.SaveToFile(filename);
  296.   finally
  297.     FreeAndNil(sl);
  298.   end;
  299. end;
  300.  
  301. procedure TVtsAsciiTable.SaveCSV(filename: string);
  302. var
  303.   sl: TStringList;
  304. begin
  305.   sl := TStringList.Create;
  306.   try
  307.     GetCSV(sl);
  308.     sl.SaveToFile(filename);
  309.   finally
  310.     FreeAndNil(sl);
  311.   end;
  312. end;
  313.  
  314. procedure TVtsAsciiTable.SetItem(Index: Integer; const Value: TVtsAsciiTableLine);
  315. begin
  316.   Inherited Items[Index] := Value;
  317. end;
  318.  
  319. { TVtsAsciiTableLine }
  320.  
  321. procedure TVtsAsciiTableLine.Clear;
  322. var
  323.   i: Integer;
  324. begin
  325.   for i := 0 to VTS_ASCII_TABLE_COLS-1 do
  326.   begin
  327.     PadChar[i] := #0;
  328.     Align[i] := taLeftJustify;
  329.     Cont[i] := '';
  330.   end;
  331. end;
  332.  
  333. procedure TVtsAsciiTableLine.SetVal(index: integer; ACont: string;
  334.   AAlign: TAlignment=taLeftJustify; APadChar: char=' ');
  335. begin
  336.   Self.Cont[index] := ACont;
  337.   Self.Align[index] := AAlign;
  338.   Self.PadChar[index] := APadChar;
  339. end;
  340.  
  341. end.
  342.