Subversion Repositories delphiutils

Rev

Rev 90 | 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.   // Create CSV
  59.   Memo2.Clear;
  60.   VirtTable.GetCSV(Memo2.Lines);
  61.   Memo2.Lines.SaveToFile('Order.csv');
  62.  
  63.   VirtTable.Free;
  64. end;
  65.  
  66. }
  67.  
  68. interface
  69.  
  70. uses
  71.   ContNrs, Classes, SysUtils;
  72.  
  73. const
  74.   VTS_ASCII_TABLE_COLS = 10;
  75.  
  76. type
  77.   TVtsAsciiTableLine = class(TObject)
  78.   public
  79.     Cont: array[0..VTS_ASCII_TABLE_COLS-1] of string;
  80.     Align: array[0..VTS_ASCII_TABLE_COLS-1] of TAlignment;
  81.     PadChar: array[0..VTS_ASCII_TABLE_COLS-1] of char;
  82.     procedure Clear;
  83.     procedure SetVal(index: integer; ACont: string; AAlign: TAlignment=taLeftJustify; APadChar: char=' ');
  84.   end;
  85.  
  86.   TVtsAsciiTableAnalysis = record
  87.     MaxLen: array[0..VTS_ASCII_TABLE_COLS-1] of integer;
  88.     Used: array[0..VTS_ASCII_TABLE_COLS-1] of boolean;
  89.     Width: integer;
  90.   end;
  91.  
  92.   TVtsAsciiTable = class(TObjectList{<TVtsAsciiTableLine>})
  93.   private
  94.     function GetItem(Index: Integer): TVtsAsciiTableLine;
  95.     procedure SetItem(Index: Integer; const Value: TVtsAsciiTableLine);
  96.   public
  97.     function GetAnalysis: TVtsAsciiTableAnalysis;
  98.     procedure GetASCIITable(sl: TStrings; spaceBetween: integer=3);
  99.     procedure GetCSV(sl: TStrings);
  100.  
  101.     procedure AddSeparator;
  102.  
  103.     // Just a little bit type-safe... The rest stays TObject for now
  104.     function Add(AObject: TVtsAsciiTableLine): Integer; reintroduce;
  105.     property Items[Index: Integer]: TVtsAsciiTableLine read GetItem write SetItem;
  106.     procedure Insert(Index: Integer; AObject: TVtsAsciiTableLine); reintroduce;
  107.   end;
  108.  
  109. implementation
  110.  
  111. { TVtsAsciiTable }
  112.  
  113. function TVtsAsciiTable.Add(AObject: TVtsAsciiTableLine): Integer;
  114. begin
  115.   result := Inherited Add(AObject);
  116. end;
  117.  
  118. procedure TVtsAsciiTable.AddSeparator;
  119. begin
  120.   Inherited Add(nil);
  121. end;
  122.  
  123. function TVtsAsciiTable.GetAnalysis: TVtsAsciiTableAnalysis;
  124. var
  125.   j: Integer;
  126.   i: Integer;
  127.   objLine: TVtsAsciiTableLine;
  128.   len: Integer;
  129. begin
  130.   for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  131.   begin
  132.     result.MaxLen[j] := 0;
  133.     result.Used[j] := false;
  134.   end;
  135.   for i := 0 to Self.Count-1 do
  136.   begin
  137.     objLine := Self.items[i] as TVtsAsciiTableLine;
  138.     if objLine <> nil then
  139.     begin
  140.       for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  141.       begin
  142.         len := Length(objLine.Cont[j]);
  143.         if len > result.MaxLen[j] then
  144.           result.MaxLen[j] := len;
  145.         if len > 0 then
  146.           result.Used[j] := true;
  147.       end;
  148.     end;
  149.   end;
  150. end;
  151.  
  152. procedure TVtsAsciiTable.GetASCIITable(sl: TStrings; spaceBetween: integer=3);
  153. var
  154.   analysis: TVtsAsciiTableAnalysis;
  155.   objLine: TVtsAsciiTableLine;
  156.   i: Integer;
  157.   sLine: string;
  158.   j: Integer;
  159.   itmp: Integer;
  160.   padchar: Char;
  161.   firstcol: boolean;
  162.   width: Integer;
  163. begin
  164.   analysis := GetAnalysis;
  165.   //sl.Clear;
  166.   for i := 0 to Self.Count-1 do
  167.   begin
  168.     objLine := Self.items[i] as TVtsAsciiTableLine;
  169.     sLine := '';
  170.     if objLine <> nil then
  171.     begin
  172.       firstcol := true;
  173.       for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  174.       begin
  175.         if not analysis.Used[j] then continue;
  176.  
  177.         padchar := objLine.PadChar[j];
  178.         if padchar = #0 then padchar := ' ';
  179.  
  180.         if firstcol then
  181.           firstcol := false
  182.         else
  183.           sLine := sLine + StringOfChar(' ', spaceBetween);
  184.  
  185.         if objLine.Align[j] = taRightJustify then
  186.         begin
  187.           sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));
  188.           sLine := sLine + objLine.Cont[j];
  189.         end
  190.         else if objLine.Align[j] = taLeftJustify then
  191.         begin
  192.           sLine := sLine + objLine.Cont[j];
  193.           sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));
  194.         end
  195.         else if objLine.Align[j] = taCenter then
  196.         begin
  197.           if Odd(analysis.MaxLen[j]-Length(objLine.Cont[j])) then itmp := 1 else itmp := 0;
  198.           sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2);
  199.           sLine := sLine + objLine.Cont[j];
  200.           sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2 + itmp);
  201.         end
  202.         else
  203.           Assert(false);
  204.       end;
  205.     end
  206.     else
  207.     begin
  208.       firstcol := true;
  209.       width := 0;
  210.       for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  211.       begin
  212.         if not analysis.Used[j] then continue;
  213.         if firstcol then
  214.           firstcol := false
  215.         else
  216.           width := width + spaceBetween;
  217.         width := width + analysis.MaxLen[j];
  218.       end;
  219.  
  220.       sLine := sLine + StringOfChar('-', Width);
  221.     end;
  222.     sl.Add(sLine);
  223.   end;
  224. end;
  225.  
  226. function CsvQuoteStr(s: string): string;
  227. begin
  228.   s := StringReplace(s, #13#10, ' ', [rfReplaceAll]);
  229.   s := StringReplace(s, #13, ' ', [rfReplaceAll]);
  230.   s := StringReplace(s, #10, ' ', [rfReplaceAll]);
  231.   if s = '' then
  232.     result := ''
  233.   else if (AnsiPos('"', s)>0) or (AnsiPos('''', s)>0) or (AnsiPos(';', s)>0) or
  234.           (AnsiPos(#9, s)>0) or (AnsiPos(' ', s)>0) then
  235.     result := '"' + StringReplace(s, '"', '""', [rfReplaceAll]) + '"'
  236.   else
  237.     result := s;
  238. end;
  239.  
  240. procedure TVtsAsciiTable.GetCSV(sl: TStrings);
  241. var
  242.   analysis: TVtsAsciiTableAnalysis;
  243.   objLine: TVtsAsciiTableLine;
  244.   i: Integer;
  245.   sLine: string;
  246.   j: Integer;
  247.   firstcol: boolean;
  248. begin
  249.   analysis := GetAnalysis;
  250.   //sl.Clear;
  251.   for i := 0 to Self.Count-1 do
  252.   begin
  253.     objLine := Self.items[i] as TVtsAsciiTableLine;
  254.     if objLine = nil then continue;
  255.     sLine := '';
  256.     firstcol := true;
  257.     for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  258.     begin
  259.       if not analysis.Used[j] then continue;
  260.       if firstcol then
  261.         firstcol := false
  262.       else
  263.         sLine := sLine + ';';
  264.       sLine := sLine + CsvQuoteStr(objLine.Cont[j]);
  265.     end;
  266.     sl.Add(sLine);
  267.   end;
  268. end;
  269.  
  270. function TVtsAsciiTable.GetItem(Index: Integer): TVtsAsciiTableLine;
  271. begin
  272.   result := (Inherited Items[Index]) as TVtsAsciiTableLine;
  273. end;
  274.  
  275. procedure TVtsAsciiTable.Insert(Index: Integer; AObject: TVtsAsciiTableLine);
  276. begin
  277.   Inherited Insert(Index, AObject);
  278. end;
  279.  
  280. procedure TVtsAsciiTable.SetItem(Index: Integer; const Value: TVtsAsciiTableLine);
  281. begin
  282.   Inherited Items[Index] := Value;
  283. end;
  284.  
  285. { TVtsAsciiTableLine }
  286.  
  287. procedure TVtsAsciiTableLine.Clear;
  288. var
  289.   i: Integer;
  290. begin
  291.   for i := 0 to VTS_ASCII_TABLE_COLS-1 do
  292.   begin
  293.     PadChar[i] := #0;
  294.     Align[i] := taLeftJustify;
  295.     Cont[i] := '';
  296.   end;
  297. end;
  298.  
  299. procedure TVtsAsciiTableLine.SetVal(index: integer; ACont: string;
  300.   AAlign: TAlignment=taLeftJustify; APadChar: char=' ');
  301. begin
  302.   Self.Cont[index] := ACont;
  303.   Self.Align[index] := AAlign;
  304.   Self.PadChar[index] := APadChar;
  305. end;
  306.  
  307. end.
  308.