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


unit AsciiTable;
 
(*
 * ASCII Table and CSV Generator Delphi Unit
 * Revision 2022-07-11
 *
 * (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);
    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;
 
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 91	Rev 92
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-10	5	* Revision 2022-07-11
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	procedure Clear;	94	procedure Clear;
94	procedure SetVal(index: integer; ACont: string; AAlign: TAlignment=taLeftJustify; APadChar: char=' ');	95	procedure SetVal(index: integer; ACont: string; AAlign: TAlignment=taLeftJustify;
-		96	APadChar: char=' '; ADoSum: boolean=false);
95	end;	97	end;
96		98
97	TVtsAsciiTableAnalysis = record	99	TVtsAsciiTableAnalysis = record
98	MaxLen: array[0..VTS_ASCII_TABLE_COLS-1] of integer;	100	MaxLen: array[0..VTS_ASCII_TABLE_COLS-1] of integer;
99	Used: array[0..VTS_ASCII_TABLE_COLS-1] of boolean;	101	Used: array[0..VTS_ASCII_TABLE_COLS-1] of boolean;
100	Sum: array[0..VTS_ASCII_TABLE_COLS-1] of integer;	102	Sum: array[0..VTS_ASCII_TABLE_COLS-1] of integer;
101	end;	103	end;
102		104
103	TVtsAsciiTable = class(TObjectList{<TVtsAsciiTableLine>})	105	TVtsAsciiTable = class(TObjectList{<TVtsAsciiTableLine>})
104	private	106	private
105	function GetItem(Index: Integer): TVtsAsciiTableLine;	107	function GetItem(Index: Integer): TVtsAsciiTableLine;
106	procedure SetItem(Index: Integer; const Value: TVtsAsciiTableLine);	108	procedure SetItem(Index: Integer; const Value: TVtsAsciiTableLine);
107	public	109	public
108	function GetAnalysis: TVtsAsciiTableAnalysis;	110	function GetAnalysis: TVtsAsciiTableAnalysis;
109	procedure GetASCIITable(sl: TStrings; spaceBetween: integer=3);	111	procedure GetASCIITable(sl: TStrings; spaceBetween: integer=3);
110	procedure SaveASCIITable(filename: string; spaceBetween: integer=3);	112	procedure SaveASCIITable(filename: string; spaceBetween: integer=3);
111	procedure GetCSV(sl: TStrings);	113	procedure GetCSV(sl: TStrings);
112	procedure SaveCSV(filename: string);	114	procedure SaveCSV(filename: string);
113		115
114	procedure AddSeparator;	116	procedure AddSeparator;
115	procedure AddSumLine;	117	procedure AddSumLine;
116		118
117	// Just a little bit type-safe... The rest stays TObject for now	119	// Just a little bit type-safe... The rest stays TObject for now
118	function Add(AObject: TVtsAsciiTableLine): Integer; reintroduce;	120	function Add(AObject: TVtsAsciiTableLine): Integer; reintroduce;
119	property Items[Index: Integer]: TVtsAsciiTableLine read GetItem write SetItem;	121	property Items[Index: Integer]: TVtsAsciiTableLine read GetItem write SetItem;
120	procedure Insert(Index: Integer; AObject: TVtsAsciiTableLine); reintroduce;	122	procedure Insert(Index: Integer; AObject: TVtsAsciiTableLine); reintroduce;
121	end;	123	end;
122		124
123	implementation	125	implementation
124		126
125	{ TVtsAsciiTable }	127	{ TVtsAsciiTable }
126		128
127	function TVtsAsciiTable.Add(AObject: TVtsAsciiTableLine): Integer;	129	function TVtsAsciiTable.Add(AObject: TVtsAsciiTableLine): Integer;
128	begin	130	begin
129	result := Inherited Add(AObject);	131	result := Inherited Add(AObject);
130	end;	132	end;
131		133
132	procedure TVtsAsciiTable.AddSeparator;	134	procedure TVtsAsciiTable.AddSeparator;
133	begin	135	begin
134	Inherited Add(nil);	136	Inherited Add(nil);
135	end;	137	end;
136		138
137	procedure TVtsAsciiTable.AddSumLine;	139	procedure TVtsAsciiTable.AddSumLine;
138	var	140	var
139	objLine: TVtsAsciiTableLine;	141	objLine: TVtsAsciiTableLine;
140	j: Integer;	142	j: Integer;
141	analysis: TVtsAsciiTableAnalysis;	143	analysis: TVtsAsciiTableAnalysis;
-		144	found: boolean;
142	begin	145	begin
143	objLine := TVtsAsciiTableLine.Create;	146	objLine := TVtsAsciiTableLine.Create;
144	objLine.IsSumLine := true;	147	objLine.IsSumLine := true;
145	analysis := GetAnalysis;	148	analysis := GetAnalysis;
-		149	found := false;
146	for j := 0 to VTS_ASCII_TABLE_COLS-1 do	150	for j := 0 to VTS_ASCII_TABLE_COLS-1 do
147	begin	151	begin
148	if analysis.Sum[j] <> 0 then	152	if analysis.Sum[j] <> 0 then
-		153	begin
149	objLine.SetVal(j, IntToStr(analysis.Sum[j]), taRightJustify, ' ');	154	objLine.SetVal(j, IntToStr(analysis.Sum[j]), taRightJustify, ' ');
-		155	found := true;
-		156	end;
150	end;	157	end;
-		158	if found then
151	Inherited Add(objLine);	159	Inherited Add(objLine)
-		160	else
-		161	objLine.Free;
152	end;	162	end;
153		163
154	function TVtsAsciiTable.GetAnalysis: TVtsAsciiTableAnalysis;	164	function TVtsAsciiTable.GetAnalysis: TVtsAsciiTableAnalysis;
155	var	165	var
156	j: Integer;	166	j: Integer;
157	i: Integer;	167	i: Integer;
158	objLine: TVtsAsciiTableLine;	168	objLine: TVtsAsciiTableLine;
159	len: Integer;	169	len: Integer;
160	itmp: integer;	170	itmp: integer;
161	begin	171	begin
162	for j := 0 to VTS_ASCII_TABLE_COLS-1 do	172	for j := 0 to VTS_ASCII_TABLE_COLS-1 do
163	begin	173	begin
164	result.MaxLen[j] := 0;	174	result.MaxLen[j] := 0;
165	result.Used[j] := false;	175	result.Used[j] := false;
166	result.Sum[j] := 0;	176	result.Sum[j] := 0;
167	end;	177	end;
168	for i := 0 to Self.Count-1 do	178	for i := 0 to Self.Count-1 do
169	begin	179	begin
170	objLine := Self.items[i] as TVtsAsciiTableLine;	180	objLine := Self.items[i] as TVtsAsciiTableLine;
171	if objLine <> nil then	181	if objLine <> nil then
172	begin	182	begin
173	for j := 0 to VTS_ASCII_TABLE_COLS-1 do	183	for j := 0 to VTS_ASCII_TABLE_COLS-1 do
174	begin	184	begin
175	len := Length(objLine.Cont[j]);	185	len := Length(objLine.Cont[j]);
176	if TryStrToInt(objLine.Cont[j], itmp) then	186	if TryStrToInt(objLine.Cont[j], itmp) and objLine.DoSum[j] then
177	result.Sum[j] := result.Sum[j] + itmp;	187	result.Sum[j] := result.Sum[j] + itmp;
178	if len > result.MaxLen[j] then	188	if len > result.MaxLen[j] then
179	result.MaxLen[j] := len;	189	result.MaxLen[j] := len;
180	if len > 0 then	190	if len > 0 then
181	result.Used[j] := true;	191	result.Used[j] := true;
182	end;	192	end;
183	end;	193	end;
184	end;	194	end;
185	end;	195	end;
186		196
187	procedure TVtsAsciiTable.GetASCIITable(sl: TStrings; spaceBetween: integer=3);	197	procedure TVtsAsciiTable.GetASCIITable(sl: TStrings; spaceBetween: integer=3);
188	var	198	var
189	analysis: TVtsAsciiTableAnalysis;	199	analysis: TVtsAsciiTableAnalysis;
190	objLine: TVtsAsciiTableLine;	200	objLine: TVtsAsciiTableLine;
191	i: Integer;	201	i: Integer;
192	sLine: string;	202	sLine: string;
193	j: Integer;	203	j: Integer;
194	itmp: Integer;	204	itmp: Integer;
195	padchar: Char;	205	padchar: Char;
196	firstcol: boolean;	206	firstcol: boolean;
197	width: Integer;	207	width: Integer;
198	begin	208	begin
199	analysis := GetAnalysis;	209	analysis := GetAnalysis;
200	//sl.Clear;	210	//sl.Clear;
201	for i := 0 to Self.Count-1 do	211	for i := 0 to Self.Count-1 do
202	begin	212	begin
203	objLine := Self.items[i] as TVtsAsciiTableLine;	213	objLine := Self.items[i] as TVtsAsciiTableLine;
204	sLine := '';	214	sLine := '';
205	if objLine <> nil then	215	if objLine <> nil then
206	begin	216	begin
207	firstcol := true;	217	firstcol := true;
208	for j := 0 to VTS_ASCII_TABLE_COLS-1 do	218	for j := 0 to VTS_ASCII_TABLE_COLS-1 do
209	begin	219	begin
210	if not analysis.Used[j] then continue;	220	if not analysis.Used[j] then continue;
211		221
212	padchar := objLine.PadChar[j];	222	padchar := objLine.PadChar[j];
213	if padchar = #0 then padchar := ' ';	223	if padchar = #0 then padchar := ' ';
214		224
215	if firstcol then	225	if firstcol then
216	firstcol := false	226	firstcol := false
217	else	227	else
218	sLine := sLine + StringOfChar(' ', spaceBetween);	228	sLine := sLine + StringOfChar(' ', spaceBetween);
219		229
220	if objLine.Align[j] = taRightJustify then	230	if objLine.Align[j] = taRightJustify then
221	begin	231	begin
222	sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));	232	sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));
223	sLine := sLine + objLine.Cont[j];	233	sLine := sLine + objLine.Cont[j];
224	end	234	end
225	else if objLine.Align[j] = taLeftJustify then	235	else if objLine.Align[j] = taLeftJustify then
226	begin	236	begin
227	sLine := sLine + objLine.Cont[j];	237	sLine := sLine + objLine.Cont[j];
228	sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));	238	sLine := sLine + StringOfChar(padchar, analysis.MaxLen[j]-Length(objLine.Cont[j]));
229	end	239	end
230	else if objLine.Align[j] = taCenter then	240	else if objLine.Align[j] = taCenter then
231	begin	241	begin
232	if Odd(analysis.MaxLen[j]-Length(objLine.Cont[j])) then itmp := 1 else itmp := 0;	242	if Odd(analysis.MaxLen[j]-Length(objLine.Cont[j])) then itmp := 1 else itmp := 0;
233	sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2);	243	sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2);
234	sLine := sLine + objLine.Cont[j];	244	sLine := sLine + objLine.Cont[j];
235	sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2 + itmp);	245	sLine := sLine + StringOfChar(padchar, (analysis.MaxLen[j]-Length(objLine.Cont[j])) div 2 + itmp);
236	end	246	end
237	else	247	else
238	Assert(false);	248	Assert(false);
239	end;	249	end;
240	end	250	end
241	else	251	else
242	begin	252	begin
243	firstcol := true;	253	firstcol := true;
244	width := 0;	254	width := 0;
245	for j := 0 to VTS_ASCII_TABLE_COLS-1 do	255	for j := 0 to VTS_ASCII_TABLE_COLS-1 do
246	begin	256	begin
247	if not analysis.Used[j] then continue;	257	if not analysis.Used[j] then continue;
248	if firstcol then	258	if firstcol then
249	firstcol := false	259	firstcol := false
250	else	260	else
251	width := width + spaceBetween;	261	width := width + spaceBetween;
252	width := width + analysis.MaxLen[j];	262	width := width + analysis.MaxLen[j];
253	end;	263	end;
254		264
255	sLine := sLine + StringOfChar('-', Width);	265	sLine := sLine + StringOfChar('-', Width);
256	end;	266	end;
257	sl.Add(sLine);	267	sl.Add(sLine);
258	end;	268	end;
259	end;	269	end;
260		270
261	function CsvQuoteStr(s: string): string;	271	function CsvQuoteStr(s: string): string;
262	begin	272	begin
263	s := StringReplace(s, #13#10, ' ', [rfReplaceAll]);	273	s := StringReplace(s, #13#10, ' ', [rfReplaceAll]);
264	s := StringReplace(s, #13, ' ', [rfReplaceAll]);	274	s := StringReplace(s, #13, ' ', [rfReplaceAll]);
265	s := StringReplace(s, #10, ' ', [rfReplaceAll]);	275	s := StringReplace(s, #10, ' ', [rfReplaceAll]);
266	if s = '' then	276	if s = '' then
267	result := ''	277	result := ''
268	else if (AnsiPos('"', s)>0) or (AnsiPos('''', s)>0) or (AnsiPos(';', s)>0) or	278	else if (AnsiPos('"', s)>0) or (AnsiPos('''', s)>0) or (AnsiPos(';', s)>0) or
269	(AnsiPos(#9, s)>0) or (AnsiPos(' ', s)>0) then	279	(AnsiPos(#9, s)>0) or (AnsiPos(' ', s)>0) then
270	result := '"' + StringReplace(s, '"', '""', [rfReplaceAll]) + '"'	280	result := '"' + StringReplace(s, '"', '""', [rfReplaceAll]) + '"'
271	else	281	else
272	result := s;	282	result := s;
273	end;	283	end;
274		284
275	procedure TVtsAsciiTable.GetCSV(sl: TStrings);	285	procedure TVtsAsciiTable.GetCSV(sl: TStrings);
276	var	286	var
277	analysis: TVtsAsciiTableAnalysis;	287	analysis: TVtsAsciiTableAnalysis;
278	objLine: TVtsAsciiTableLine;	288	objLine: TVtsAsciiTableLine;
279	i: Integer;	289	i: Integer;
280	sLine: string;	290	sLine: string;
281	j: Integer;	291	j: Integer;
282	firstcol: boolean;	292	firstcol: boolean;
283	begin	293	begin
284	analysis := GetAnalysis;	294	analysis := GetAnalysis;
285	//sl.Clear;	295	//sl.Clear;
286	for i := 0 to Self.Count-1 do	296	for i := 0 to Self.Count-1 do
287	begin	297	begin
288	objLine := Self.items[i] as TVtsAsciiTableLine;	298	objLine := Self.items[i] as TVtsAsciiTableLine;
289	if objLine = nil then continue;	299	if objLine = nil then continue;
290	if objLine.IsSumLine then continue;	300	if objLine.IsSumLine then continue;
291	sLine := '';	301	sLine := '';
292	firstcol := true;	302	firstcol := true;
293	for j := 0 to VTS_ASCII_TABLE_COLS-1 do	303	for j := 0 to VTS_ASCII_TABLE_COLS-1 do
294	begin	304	begin
295	if not analysis.Used[j] then continue;	305	if not analysis.Used[j] then continue;
296	if firstcol then	306	if firstcol then
297	firstcol := false	307	firstcol := false
298	else	308	else
299	sLine := sLine + ';';	309	sLine := sLine + ';';
300	sLine := sLine + CsvQuoteStr(objLine.Cont[j]);	310	sLine := sLine + CsvQuoteStr(objLine.Cont[j]);
301	end;	311	end;
302	sl.Add(sLine);	312	sl.Add(sLine);
303	end;	313	end;
304	end;	314	end;
305		315
306	function TVtsAsciiTable.GetItem(Index: Integer): TVtsAsciiTableLine;	316	function TVtsAsciiTable.GetItem(Index: Integer): TVtsAsciiTableLine;
307	begin	317	begin
308	result := (Inherited Items[Index]) as TVtsAsciiTableLine;	318	result := (Inherited Items[Index]) as TVtsAsciiTableLine;
309	end;	319	end;
310		320
311	procedure TVtsAsciiTable.Insert(Index: Integer; AObject: TVtsAsciiTableLine);	321	procedure TVtsAsciiTable.Insert(Index: Integer; AObject: TVtsAsciiTableLine);
312	begin	322	begin
313	Inherited Insert(Index, AObject);	323	Inherited Insert(Index, AObject);
314	end;	324	end;
315		325
316	procedure TVtsAsciiTable.SaveASCIITable(filename: string;	326	procedure TVtsAsciiTable.SaveASCIITable(filename: string;
317	spaceBetween: integer);	327	spaceBetween: integer);
318	var	328	var
319	sl: TStringList;	329	sl: TStringList;
320	begin	330	begin
321	sl := TStringList.Create;	331	sl := TStringList.Create;
322	try	332	try
323	GetASCIITable(sl, spaceBetween);	333	GetASCIITable(sl, spaceBetween);
324	sl.SaveToFile(filename);	334	sl.SaveToFile(filename);
325	finally	335	finally
326	FreeAndNil(sl);	336	FreeAndNil(sl);
327	end;	337	end;
328	end;	338	end;
329		339
330	procedure TVtsAsciiTable.SaveCSV(filename: string);	340	procedure TVtsAsciiTable.SaveCSV(filename: string);
331	var	341	var
332	sl: TStringList;	342	sl: TStringList;
333	begin	343	begin
334	sl := TStringList.Create;	344	sl := TStringList.Create;
335	try	345	try
336	GetCSV(sl);	346	GetCSV(sl);
337	sl.SaveToFile(filename);	347	sl.SaveToFile(filename);
338	finally	348	finally
339	FreeAndNil(sl);	349	FreeAndNil(sl);
340	end;	350	end;
341	end;	351	end;
342		352
343	procedure TVtsAsciiTable.SetItem(Index: Integer; const Value: TVtsAsciiTableLine);	353	procedure TVtsAsciiTable.SetItem(Index: Integer; const Value: TVtsAsciiTableLine);
344	begin	354	begin
345	Inherited Items[Index] := Value;	355	Inherited Items[Index] := Value;
346	end;	356	end;
347		357
348	{ TVtsAsciiTableLine }	358	{ TVtsAsciiTableLine }
349		359
350	procedure TVtsAsciiTableLine.Clear;	360	procedure TVtsAsciiTableLine.Clear;
351	var	361	var
352	i: Integer;	362	i: Integer;
353	begin	363	begin
354	for i := 0 to VTS_ASCII_TABLE_COLS-1 do	364	for i := 0 to VTS_ASCII_TABLE_COLS-1 do
355	begin	365	begin
356	PadChar[i] := #0;	366	PadChar[i] := #0;
357	Align[i] := taLeftJustify;	367	Align[i] := taLeftJustify;
358	Cont[i] := '';	368	Cont[i] := '';
359	end;	369	end;
360	end;	370	end;
361		371
362	procedure TVtsAsciiTableLine.SetVal(index: integer; ACont: string;	372	procedure TVtsAsciiTableLine.SetVal(index: integer; ACont: string;
363	AAlign: TAlignment=taLeftJustify; APadChar: char=' ');	373	AAlign: TAlignment=taLeftJustify; APadChar: char=' '; ADoSum: boolean=false);
364	begin	374	begin
365	Self.Cont[index] := ACont;	375	Self.Cont[index] := ACont;
366	Self.Align[index] := AAlign;	376	Self.Align[index] := AAlign;
367	Self.PadChar[index] := APadChar;	377	Self.PadChar[index] := APadChar;
-		378	Self.DoSum[index] := ADoSum;
368	end;	379	end;
369		380
370	end.	381	end.
371		382

Subversion Repositories delphiutils

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