unit USLISTEX;
(*
	ストリングリスト拡張
*)
interface

uses
	Windows, SysUtils, Classes;

// TStringList 拡張
type
	TStringListEx = class(TStringList)
	private
		FRow: TStringList;
	public
		constructor Create;
		destructor  Destroy; override;
		procedure   LoadFromFile(const FileName: string); override;
		procedure   SaveToFile(const FileName: string); override;
		procedure   AppendToFile(const FileName: string);
	private
		function    getFieldCount(ARow: integer): integer;
		function    getCells(ACol, ARow: integer): string;
		procedure   setCells(ACol, ARow: integer; Value: string);
		function    getFieldText(ASeparater: char): string;
		procedure   setFieldText(ASeparater: char; Value: string);
	public
		property    Cells[ACol, ARow: integer]: string read getCells write setCells;
		property    FieldCount[ARow: integer]: integer read getFieldCount;
		property    FieldText[Separater: char]: string read getFieldText write setFieldText;
	end;

implementation

{-------------------------------------------------------------------}

constructor TStringListEx.Create;
begin
	inherited Create;
	FRow := TStringList.Create;
end;

destructor  TStringListEx.Destroy;
begin
	FRow.Free;
	inherited Destroy;
end;

procedure   TStringListEx.LoadFromFile(const FileName: string);
var
	st: string;
	Stream: TStream;
begin
	st := AnsiUpperCase(ExtractFileName(FileName));
	if  (st = '') or (st = 'CON') or (st = 'CONIN$') then
	begin
		Stream := THandleStream.Create(GetStdHandle(STD_INPUT_HANDLE))
	end else begin
		Stream := TFileStream.Create(FileName, fmOpenRead);
	end;
	try
		LoadFromStream(Stream);
	finally
		Stream.free;
	end;
end;

procedure   TStringListEx.SaveToFile(const FileName: string);
var
	st: string;
	Stream: TStream;
begin
	st := AnsiUpperCase(ExtractFileName(FileName));
	if  (st = '') or (st = 'CON') or (st = 'CONOUT$') then
	begin
		Stream := THandleStream.Create(GetStdHandle(STD_OUTPUT_HANDLE))
	end else begin
		Stream := TFileStream.Create(FileName, fmCreate);
	end;
	try
		SaveToStream(Stream);
	finally
		Stream.free;
	end;
end;

procedure   TStringListEx.AppendToFile(const FileName: string);
var
	st: string;
	Stream: TStream;
begin
	st := AnsiUpperCase(ExtractFileName(FileName));
	if  (st = '') or (st = 'CON') or (st = 'CONOUT$') then
	begin
		Stream := THandleStream.Create(GetStdHandle(STD_OUTPUT_HANDLE))
	end else begin
		try
			Stream := TFileStream.Create(FileName, fmOpenReadWrite);
			Stream.Seek(0, soFromEnd);
		except
			Stream := TFileStream.Create(FileName, fmCreate);
		end;
	end;
	try
		SaveToStream(Stream);
	finally
		Stream.free;
	end;
end;

{-------------------------------------------------------------------}

function    TStringListEx.getFieldCount(ARow: integer): integer;
begin
	result := 0;
	if Count = 0 then
		exit;
	if ARow >= Count then
		exit;
	FRow.CommaText := Strings[ARow];
	result := FRow.Count;
end;

function    TStringListEx.getCells(ACol, ARow: integer): string;
begin
	result := '';
	if Count = 0 then
		exit;
	if ARow >= Count then
		exit;
	FRow.CommaText := Strings[ARow];
	if FRow.Count = 0 then
		exit;
	if ACol >= FRow.Count then
		exit;
	result := FRow.Strings[ACol];
end;

procedure   TStringListEx.setCells(ACol, ARow: integer; Value: string);
begin
	while ( ARow >= Count ) do
		Add('');
	FRow.CommaText := Strings[ARow];
	while ( ACol >= FRow.Count ) do
		FRow.Add('');
	FRow.Strings[ACol] := Value;
	Strings[ARow] := FRow.CommaText;
end;

function    TStringListEx.getFieldText(ASeparater: char): string;
var
	i: integer;
begin
	result := '';
	if Count = 0 then
		exit;
	result := Strings[0];
	for i := 1 to Count-1 do
		result := result + ASeparater + Strings[i];
end;

procedure   TStringListEx.setFieldText(ASeparater: char; Value: string);
var
	i: integer;
	
begin
	Clear;
	while Value <> '' do
	begin
		i := pos(ASeparater, Value);
		if i <> 0 then
		begin
			Add(copy(Value, 1, i-1));
			system.delete(Value, 1, i);
		end else
		begin
			Add(Value);
			Value := '';
		end;
	end;
end;

{-------------------------------------------------------------------}

end.