WebSVN – delphiutils – Diff – /trunk/Units/AsciiTable.pas


unit AsciiTable;
 
(*
 * ASCII Table and CSV Generator Delphi Unit
 * Revision 2022-07-15
 *
 * (C) 2022 Daniel Marschall, HickelSOFT, ViaThinkSoft
 * Licensed under the terms of Apache 2.0
 *)
 
{
 
Example usage:
 
uses
  AsciiTable, ContNrs;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  VirtTable: TVtsAsciiTable;
  objLine: TVtsAsciiTableLine;
begin
  VirtTable := TVtsAsciiTable.Create(true);
  VirtTable.Clear;
 
  // Create Test data
  objLine := TVtsAsciiTableLine.Create;
  objLine.SetVal(0, 'Fruit', taCenter);
  objLine.SetVal(1, 'Amount', taCenter);
  VirtTable.Add(objLine);
 
  VirtTable.AddSeparator;
 
  objLine := TVtsAsciiTableLine.Create;
  objLine.SetVal(0, 'Apple', taLeftJustify);
  objLine.SetVal(1, '123', taRightJustify);
  VirtTable.Add(objLine);
 
  objLine := TVtsAsciiTableLine.Create;
  objLine.SetVal(0, 'Kiwi', taLeftJustify);
  objLine.SetVal(1, '1', taRightJustify);
  VirtTable.Add(objLine);
 
  objLine := TVtsAsciiTableLine.Create;
  objLine.SetVal(0, 'Asparagus (green)', taLeftJustify);
  objLine.SetVal(1, '9999', taRightJustify);
  VirtTable.Add(objLine);
 
  objLine := TVtsAsciiTableLine.Create;
  objLine.SetVal(0, 'Asparagus (white)', taLeftJustify);
  objLine.SetVal(1, '999', taRightJustify);
  VirtTable.Add(objLine);
 
  VirtTable.AddSeparator;
  VirtTable.AddSumLine;
 
  // Create ASCII table
  Memo1.Clear;
  VirtTable.GetASCIITable(Memo1.Lines);
 
  // Save ASCII table
  VirtTable.SaveASCIITable('Order.txt');
 
  // Create CSV
  Memo2.Clear;
  VirtTable.GetCSV(Memo2.Lines);
 
  // Save CSV
  VirtTable.SaveCSV('Order.csv');
 
  VirtTable.Free;
end;
 
}
 
interface
 
uses
  ContNrs, Classes, SysUtils;
 
const
  VTS_ASCII_TABLE_COLS = 10;
 
type
  TVtsAsciiTableLine = class(TObject)
  private
    IsSumLine: boolean;
    //IsSeparator: boolean;
  public
    Cont: array[0..VTS_ASCII_TABLE_COLS-1] of string;
    Align: array[0..VTS_ASCII_TABLE_COLS-1] of TAlignment;
    PadChar: array[0..VTS_ASCII_TABLE_COLS-1] of char;
    DoSum: array[0..VTS_ASCII_TABLE_COLS-1] of boolean;
    procedure Clear;
    procedure SetVal(index: integer; ACont: string; AAlign: TAlignment=taLeftJustify;
      APadChar: char=' '; ADoSum: boolean=false);
  end;
 
  TVtsAsciiTableAnalysis = record
    MaxLen: array[0..VTS_ASCII_TABLE_COLS-1] of integer;
    Used: array[0..VTS_ASCII_TABLE_COLS-1] of boolean;
    Sum: array[0..VTS_ASCII_TABLE_COLS-1] of integer;
  end;
 
  TVtsAsciiTable = class(TObjectList{<TVtsAsciiTableLine>})
  private
    function GetItem(Index: Integer): TVtsAsciiTableLine;
    procedure SetItem(Index: Integer; const Value: TVtsAsciiTableLine);
  public
    function GetAnalysis: TVtsAsciiTableAnalysis;
    procedure GetASCIITable(sl: TStrings; spaceBetween: integer=3); overload;
    function GetASCIITable(spaceBetween: integer=3): string; overload;
    procedure SaveASCIITable(filename: string; spaceBetween: integer=3);
    procedure GetCSV(sl: TStrings);
    procedure SaveCSV(filename: string);
 
    procedure AddSeparator;
    procedure AddSumLine;
 
    // Just a little bit type-safe... The rest stays TObject for now
    function Add(AObject: TVtsAsciiTableLine): Integer; reintroduce;
    property Items[Index: Integer]: TVtsAsciiTableLine read GetItem write SetItem;
    procedure Insert(Index: Integer; AObject: TVtsAsciiTableLine); reintroduce;
  end;
 
implementation
 
{ TVtsAsciiTable }
 
function TVtsAsciiTable.Add(AObject: TVtsAsciiTableLine): Integer;
begin
  result := Inherited Add(AObject);
end;
 
procedure TVtsAsciiTable.AddSeparator;
begin
  Inherited Add(nil);
end;
 
procedure TVtsAsciiTable.AddSumLine;
var
  objLine: TVtsAsciiTableLine;
  j: Integer;
  analysis: TVtsAsciiTableAnalysis;
  found: boolean;
begin
  objLine := TVtsAsciiTableLine.Create;
  objLine.IsSumLine := true;
  analysis := GetAnalysis;
  found := false;
  for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  begin
    if analysis.Sum[j] <> 0 then
    begin
      objLine.SetVal(j, IntToStr(analysis.Sum[j]), taRightJustify, ' ');
      found := true;
    end;
  end;
  if found then
    Inherited Add(objLine)
  else
    objLine.Free;
end;
 
function TVtsAsciiTable.GetAnalysis: TVtsAsciiTableAnalysis;
var
  j: Integer;
  i: Integer;
  objLine: TVtsAsciiTableLine;
  len: Integer;
  itmp: integer;
begin
  for j := 0 to VTS_ASCII_TABLE_COLS-1 do
  begin
    result.MaxLen[j] := 0;
    result.Used[j] := false;
    result.Sum[j] := 0;
  end;
  for i := 0 to Self.Count-1 do
  begin
    objLine := Self.items[i] as TVtsAsciiTableLine;
    if objLine <> nil then
    begin
      for j := 0 to VTS_ASCII_TABLE_COLS-1 do
      begin
        len := Length(objLine.Cont[j]);
        if TryStrToInt(objLine.Cont[j], itmp) and objLine.DoSum[j] then
          result.Sum[j] := result.Sum[j] + itmp;
        if len > result.MaxLen[j] then
          result.MaxLen[j] := len;
        if len > 0 then
          result.Used[j] := true;
      end;
    end;
  end;
end;
 
function TVtsAsciiTable.GetASCIITable(spaceBetween: integer): string;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    GetASCIITable(sl, spaceBetween);
    result := sl.Text;
  finally
    FreeAndNil(sl);
  end;
end;
 
procedure TVtsAsciiTable.GetASCIITable(sl: TStrings; spaceBetween: integer=3);
var
  analysis: TVtsAsciiTableAnalysis;
  objLine: TVtsAsciiTableLine;
  i: Integer;
  sLine: string;
  j: Integer;
  itmp: Integer;
  padchar: Char;
  firstcol: boolean;
  width: Integer;
begin
  analysis := GetAnalysis;
  //sl.Clear;
  for i := 0 to Self.Count-1 do
  begin
    objLine := Self.items[i] as TVtsAsciiTableLine;
    sLine := '';
    if objLine <> nil then
    begin
      firstcol := true;
      for j := 0 to VTS_ASCII_TABLE_COLS-1 do
      begin
        if not analysis.Used[j] then continue;
 
        padchar := objLine.PadChar[j];
        if padchar = #0 then padchar := ' ';
 
        if firstcol then
          firstcol := false
        else
          sLine := sLine + StringOfChar(' ', spaceBetween);
 
        if objLine.Align[j] = taRightJustify then
        begin
          sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));
          sLine := sLine + objLine.Cont[j];
        end
        else if objLine.Align[j] = taLeftJustify then
        begin
          sLine := sLine + objLine.Cont[j];
          sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));
        end
        else if objLine.Align[j] = taCenter then
        begin
          if Odd(analysis.MaxLen[j]-Length(objLine.Cont[j])) then itmp := 1 else itmp := 0;
          sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2);
          sLine := sLine + objLine.Cont[j];
          sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2 + itmp);
        end
        else
          Assert(false);
      end;
    end
    else
    begin
      firstcol := true;
      width := 0;
      for j := 0 to VTS_ASCII_TABLE_COLS-1 do
      begin
        if not analysis.Used[j] then continue;
        if firstcol then
          firstcol := false
        else
          width := width + spaceBetween;
        width := width + analysis.MaxLen[j];
      end;
 
      sLine := sLine + StringOfChar('-', Width);
    end;
    sl.Add(sLine);
  end;
end;
 
function CsvQuoteStr(s: string): string;
begin
  s := StringReplace(s, #13#10, ' ', [rfReplaceAll]);
  s := StringReplace(s, #13, ' ', [rfReplaceAll]);
  s := StringReplace(s, #10, ' ', [rfReplaceAll]);
  if s = '' then
    result := ''
  else if (AnsiPos('"', s)>0) or (AnsiPos('''', s)>0) or (AnsiPos(';', s)>0) or
          (AnsiPos(#9, s)>0) or (AnsiPos(' ', s)>0) then
    result := '"' + StringReplace(s, '"', '""', [rfReplaceAll]) + '"'
  else
    result := s;
end;
 
procedure TVtsAsciiTable.GetCSV(sl: TStrings);
var
  analysis: TVtsAsciiTableAnalysis;
  objLine: TVtsAsciiTableLine;
  i: Integer;
  sLine: string;
  j: Integer;
  firstcol: boolean;
begin
  analysis := GetAnalysis;
  //sl.Clear;
  for i := 0 to Self.Count-1 do
  begin
    objLine := Self.items[i] as TVtsAsciiTableLine;
    if objLine = nil then continue;
    if objLine.IsSumLine then continue;
    sLine := '';
    firstcol := true;
    for j := 0 to VTS_ASCII_TABLE_COLS-1 do
    begin
      if not analysis.Used[j] then continue;
      if firstcol then
        firstcol := false
      else
        sLine := sLine + ';';
      sLine := sLine + CsvQuoteStr(objLine.Cont[j]);
    end;
    sl.Add(sLine);
  end;
end;
 
function TVtsAsciiTable.GetItem(Index: Integer): TVtsAsciiTableLine;
begin
  result := (Inherited Items[Index]) as TVtsAsciiTableLine;
end;
 
procedure TVtsAsciiTable.Insert(Index: Integer; AObject: TVtsAsciiTableLine);
begin
  Inherited Insert(Index, AObject);
end;
 
procedure TVtsAsciiTable.SaveASCIITable(filename: string;
  spaceBetween: integer);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    GetASCIITable(sl, spaceBetween);
    sl.SaveToFile(filename);
  finally
    FreeAndNil(sl);
  end;
end;
 
procedure TVtsAsciiTable.SaveCSV(filename: string);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    GetCSV(sl);
    sl.SaveToFile(filename);
  finally
    FreeAndNil(sl);
  end;
end;
 
procedure TVtsAsciiTable.SetItem(Index: Integer; const Value: TVtsAsciiTableLine);
begin
  Inherited Items[Index] := Value;
end;
 
{ TVtsAsciiTableLine }
 
procedure TVtsAsciiTableLine.Clear;
var
  i: Integer;
begin
  for i := 0 to VTS_ASCII_TABLE_COLS-1 do
  begin
    PadChar[i] := #0;
    Align[i] := taLeftJustify;
    Cont[i] := '';
  end;
end;
 
procedure TVtsAsciiTableLine.SetVal(index: integer; ACont: string;
  AAlign: TAlignment=taLeftJustify; APadChar: char=' '; ADoSum: boolean=false);
begin
  Self.Cont[index] := ACont;
  Self.Align[index] := AAlign;
  Self.PadChar[index] := APadChar;
  Self.DoSum[index] := ADoSum;
end;
 
end.
 

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

Subversion Repositories delphiutils

delphiutils/trunk/Units/AsciiTable.pas – Rev 92 → 93