unit UStringTable;
interface
uses
Classes;
type
TStringTable =
class
private
FTableColumns :
array of TStringList;
FDelimiter :
String;
FBoundary :
String;
FCrNlScheme :
String;
function GetCell(Row, Col: Integer):
String;
function GetColCount: Integer;
function GetRowCount: Integer;
procedure SetCell(Row, Col: Integer;
const Value:
String);
procedure SetColCount(
const Value: Integer);
procedure SetRowCount(
const Value: Integer);
function GetCSV:
String;
procedure SetCSV(
const Value:
String);
public
constructor Create;
destructor Destroy;
override;
procedure Clear;
function CSVtoFile(Filepath :
String): Integer;
property Delimiter :
String Read FDelimiter
Write FDelimiter;
property Boundary :
String Read FBoundary
Write FBoundary;
property CrNlScheme :
String Read FCrNlScheme
Write FCrNlScheme;
property Cell[Row, Col: Integer]:
String Read GetCell
Write SetCell;
property RowCount : Integer
Read GetRowCount
Write SetRowCount;
property ColCount : Integer
Read GetColCount
Write SetColCount;
property CSV :
String Read GetCSV
Write SetCSV;
end;
implementation
{ TStringTable }
constructor TStringTable.Create;
begin
FDelimiter := '
,';
FBoundary := '
"';
FCrNlScheme := #13#10;
end;
destructor TStringTable.Destroy;
begin
self.Clear;
inherited;
end;
procedure TStringTable.Clear;
var
i : Integer;
begin
for i := 0
to Length(FTableColumns) -1
do
FTableColumns[i].Free;
SetLength(FTableColumns, 0);
end;
function TStringTable.GetColCount: Integer;
begin
Result := length(FTableColumns);
end;
procedure TStringTable.SetColCount(
const Value: Integer);
var
i, j : Integer;
begin
if Value < 0
then Exit;
while (self.ColCount > Value)
do
begin
i := Length(FTableColumns) - 1;
FTableColumns[i].Free;
SetLength(FTableColumns, i);
end;
while (self.ColCount < Value)
do
begin
i := Length(FTableColumns);
SetLength(FTableColumns, i + 1);
FTableColumns[i] := TStringList.Create;
// set new Column to current RowCount
for j := 0
to self.RowCount -1
do
FTableColumns[i].Add('
');
end;
end;
function TStringTable.GetRowCount: Integer;
begin
if (Length(FTableColumns) > 0)
then
Result := FTableColumns[0].Count
else
Result := 0;
end;
procedure TStringTable.SetRowCount(
const Value: Integer);
var
i : Integer;
begin
if Value < 0
then Exit;
while (self.RowCount > Value)
do
begin
for i := 0
to self.ColCount -1
do
FTableColumns[i].Delete(self.ColCount -1);
end;
while (self.RowCount < Value)
do
begin
for i := 0
to self.ColCount -1
do
FTableColumns[i].Add('
');
end;
end;
function TStringTable.GetCell(Row, Col: Integer):
String;
begin
Result := FTableColumns[Col][Row];
end;
procedure TStringTable.SetCell(Row, Col: Integer;
const Value:
String);
begin
if (Col >= self.ColCount)
then
self.ColCount := Col + 1;
if (Row >= self.RowCount)
then
self.RowCount := Row + 1;
FTableColumns[Col][Row] := Value;
end;
function TStringTable.GetCSV:
String;
var
r, c, rCount, cCount : Integer;
begin
Result := '
';
rCount := self.RowCount;
cCount := self.ColCount;
for r := 0
to rCount -1
do
begin
for c := 0
to cCount -1
do
begin
Result := Result +
FBoundary +
self.Cell[r, c] +
FBoundary;
if (c < (cCount - 1))
then
Result := Result + FDelimiter;
end;
if (r < (rCount -1))
then
Result := Result + FCrNlScheme;
end;
end;
procedure TStringTable.SetCSV(
const Value:
String);
begin
// ToDo...
end;
function TStringTable.CSVtoFile(Filepath:
String): Integer;
begin
// ToDo...
Result := 0;
// returns last Win32 Error
end;
end.