TStringList Equivalent

Hi, i have a TStringList  Equivalent because i dont want to use classes in my project, but i have a problem, the thing does not have a index of function because when i use,

Uses strlist;
procedure TForm1.BUTTON1CLICK(Sender: TObject);
begin
L:=TSTRLIST.CREATE;
L.LoadFromFile('C:\FILE.TXT');
FOR I := 0 TO L.Count -1 DO
BEGIN
  S:=L[I];  // I get an error right here, Class does not have a default property:
  showmessage(S);
 I get an error


This is the class i am using

unit strlist;

interface

type
  TStrList = Class(TObject)
  private
    vList: Array of String;
    ListLn: Integer;
  public
    constructor Create;
    destructor Destroy;

    procedure SaveToFile(Filename: String);
    procedure LoadFromFile(Filename: String);

    procedure Add(Text: String);
    function Text: String;
    function Strings(Index: Integer): String;

    procedure Clear;
    function Find(TextFind: String; var Index: Integer): Boolean;
    procedure Delete(Index: Integer);
    function Count: Integer;
    procedure Replace(Index: Integer; Input: String);
  end;

implementation

constructor TStrList.Create;
begin
  ListLn := 0;
  SetLength(vList, ListLn + 1);
end;

destructor TStrList.Destroy;
begin
  Clear;
  Listln := 0;
end;

procedure TStrList.LoadFromFile(FileName:string);
var
  F: TextFile;
  T: String;
  Len: LongInt;
begin
  Clear;
  AssignFile(F, FileName);
  Reset(F);

  While not Eof(F) do
  begin
    Readln(F, T);
    If T <> '' then
    begin
      SetLength(vList, ListLn + 1);
      vList[ListLn] := T;
    end;
    Inc(ListLn);
  end;

  CloseFile(F);
end;

procedure TStrList.SaveToFile(Filename: String);
var
  F: TextFile;
  i: Integer;
begin
  AssignFile(F, Filename);
  ReWrite(F);
  for i := 0 to ListLn-1 do
    WriteLn(F, vList[i] + #13);
  CloseFile(F);
end;

procedure TStrList.Add(Text: String);
begin
  SetLength(vList, ListLn + 1);
  vList[Listln] := Text;
  Inc(Listln);
end;

procedure TStrList.Clear;
var
  i: Integer;
begin
  For i := 0 to ListLn-1 do
    vList[i] := '';
  Listln := 0;
end;

function TStrList.Find(TextFind: String; var Index: Integer): Boolean;
var
  i: Integer;
begin
  For i := 0 to ListLn do
    If Copy(vList[i], 1, Length(TextFind)) = TextFind then
    begin
      Index := i;
      Result := True;
      Exit;
    end
    else
      Result := False;
end;

procedure TStrList.Delete(Index: Integer);
var
  TempArray: array of String;
  i, ix: Integer;
Begin
  If (Index < 0) or (Index >= ListLn) or (ListLn = 0) then Exit;
  Dec(ListLn);

  SetLength(TempArray, ListLn);
  ix := 0;

  for i := 0 to ListLn do
    If i <> Index then
    begin
      TempArray[ix] := vList[i];
      Inc(ix);
    end;

  SetLength(vList, ListLn);
  For i := 0 to ListLn-1 do
    vList[i] := TempArray[i];

  TempArray := nil;
End;

function TStrList.Text: String;
var
  i: Integer;
  Txt: String;
begin
  For i := 0 to ListLn-1 do
    Txt := Txt + vList[i] + #13;

  Txt := Copy(Txt, 1, Length(Txt)-1);
  Result := Txt;
end;

function TStrList.Strings(Index: Integer): String;
begin
  Result := vList[Index];
end;

procedure TStrList.Replace(Index: Integer; Input: String);
begin
  vList[Index] := Input;
end;

function TStrList.Count: Integer;
begin
  Result := ListLn;
end;

end.
KLOPEKSAsked:
Who is Participating?
 
kretzschmarConnect With a Mentor Commented:
yes,

of course

these methods you must implement

function GetCommaText : String;
procedure SetCommaText(AValue : String);
 
a sample

function TStrList.GetCommaText : String;
var i : integer;
begin
  result := '';
  if count > 0 then
  begin
    for i := 0 to count-2 do
      result := result + vlist[i] +',';
    result := result + vlist[count-1];
  end;
end;

//helper function
function splitstr(var astring : String; Delimiter : String) : String;
var
  p : Integer;
begin
  result := '';
  if AString <> '' then
  begin
    p := pos(Delimiter,AString);
    if p > 0 then
    begin
      result := copy(AString,1,p-1);
      AString := copy(AString,p+length(Delimiter),maxLongInt);
    end
    else
    begin
      result := AString;
      AString := '';
    end;
  end;
end;

procedure TStrList.SetCommaText(AValue : String);
var s : string;
begin
  clear;
  s := AValue;
  while s <> '' do
    add(splitstr(s,','));
end;

well, just from head, not tested, typos possible

meikl ;-)

   

0
 
shaneholmesCommented:
Use
 
 S:= L.Strings(I);

Shane
0
 
kretzschmarCommented:
you need a additonal function in your selfmade-object like

function TStrList.Get(AIndex : Integer) : string;
begin
  result := '';
  if (AIndex > - 1) and (AIndex < high(vList) then
    result := vList[i]
  else
    raise exception.Create('Index out of Bounds');
end;

use it like

FOR I := 0 TO L.Count -1 DO
BEGIN
  S:=L.Get(I);  
....

just from head

meikl ;-)
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
shaneholmesCommented:
OR

change the following

function TStrList.Strings(Index: Integer): String;
begin
  if (Index > - 1) and (Index < high(vList) then
    result := vList[i]
  else
    raise exception.Create('Index out of Bounds');
end;



then use
 
 S:= L.Strings(I)

Shane
0
 
KLOPEKSAuthor Commented:
now it's giving me an error at

S.CommaText := function(TStrList);


0
 
kretzschmarCommented:
?? how did you implement it ??
if you has it implemented
0
 
shaneholmesCommented:
Above, if have S as a string

 do you mean

 L.CommaText:= 'Some comma separated text here';


I have no idea what you are doing here:

function(TStrList);


Shane
0
 
KLOPEKSAuthor Commented:
procedure TForm1.Button1Click(Sender: TObject);
var
  L: TStrList;
  L2: TStrList;
begin
  L := TStriList.Create;
  L2:= TStrList.Create;
  L2.CommaText := ProcessSearchRec (L);
 end;
end.
0
 
shaneholmesCommented:

 You are getting an error here?

  L2.CommaText := ProcessSearchRec (L);

 Can we see the function code (processSearchRec)

Shane
0
 
KLOPEKSAuthor Commented:
the result of processSearchRec is a TStriList
0
 
shaneholmesCommented:
OK, well you can't assign a TStrilList to a string property.

You will have to typecast it to get to its commaText property

L2.CommaText := TStriList(ProcessSearchRec (L)).CommaText;

Shane
0
 
KLOPEKSAuthor Commented:
i get an error" left side cannot be assigned to"
0
 
snehanshuCommented:
KLOPEKS,
  I can't understand how you managed to get commatext property from your code above (you will need to add a commatext property to your code for that), but for your initial
>>S:=L[I];  
problem, you could add an items property which acts as default. here's the modified code that will allow you to use S:=L[I];

unit strlist;

interface

type
  TStrList = Class(TObject)
  private
    vList: Array of String;
    ListLn: Integer;
//04062004:Shu-for items
    function getstring(index: integer): string;
    procedure setstring(index: integer; const Value: string);
  public
    constructor Create;
    destructor Destroy;

    procedure SaveToFile(Filename: String);
    procedure LoadFromFile(Filename: String);

    procedure Add(Text: String);
    function Text: String;
    function Strings(Index: Integer): String;

    procedure Clear;
    function Find(TextFind: String; var Index: Integer): Boolean;
    procedure Delete(Index: Integer);
    function Count: Integer;
    procedure Replace(Index: Integer; Input: String);
//04062004:Shu-to access items by index
    property item[index:integer]:string read getstring write setstring;default;
  end;

implementation

constructor TStrList.Create;
begin
  ListLn := 0;
  SetLength(vList, ListLn + 1);
end;

destructor TStrList.Destroy;
begin
  Clear;
  Listln := 0;
end;

procedure TStrList.LoadFromFile(FileName:string);
var
  F: TextFile;
  T: String;
  Len: LongInt;
begin
  Clear;
  AssignFile(F, FileName);
  Reset(F);

  While not Eof(F) do
  begin
    Readln(F, T);
    If T <> '' then
    begin
      SetLength(vList, ListLn + 1);
      vList[ListLn] := T;
    end;
    Inc(ListLn);
  end;

  CloseFile(F);
end;

procedure TStrList.SaveToFile(Filename: String);
var
  F: TextFile;
  i: Integer;
begin
  AssignFile(F, Filename);
  ReWrite(F);
  for i := 0 to ListLn-1 do
    WriteLn(F, vList[i] + #13);
  CloseFile(F);
end;

procedure TStrList.Add(Text: String);
begin
  SetLength(vList, ListLn + 1);
  vList[Listln] := Text;
  Inc(Listln);
end;

procedure TStrList.Clear;
var
  i: Integer;
begin
  For i := 0 to ListLn-1 do
    vList[i] := '';
  Listln := 0;
end;

function TStrList.Find(TextFind: String; var Index: Integer): Boolean;
var
  i: Integer;
begin
  For i := 0 to ListLn do
    If Copy(vList[i], 1, Length(TextFind)) = TextFind then
    begin
      Index := i;
      Result := True;
      Exit;
    end
    else
      Result := False;
end;

procedure TStrList.Delete(Index: Integer);
var
  TempArray: array of String;
  i, ix: Integer;
Begin
  If (Index < 0) or (Index >= ListLn) or (ListLn = 0) then Exit;
  Dec(ListLn);

  SetLength(TempArray, ListLn);
  ix := 0;

  for i := 0 to ListLn do
    If i <> Index then
    begin
      TempArray[ix] := vList[i];
      Inc(ix);
    end;

  SetLength(vList, ListLn);
  For i := 0 to ListLn-1 do
    vList[i] := TempArray[i];

  TempArray := nil;
End;

function TStrList.Text: String;
var
  i: Integer;
  Txt: String;
begin
  For i := 0 to ListLn-1 do
    Txt := Txt + vList[i] + #13;

  Txt := Copy(Txt, 1, Length(Txt)-1);
  Result := Txt;
end;

function TStrList.Strings(Index: Integer): String;
begin
  Result := vList[Index];
end;

procedure TStrList.Replace(Index: Integer; Input: String);
begin
  vList[Index] := Input;
end;

function TStrList.Count: Integer;
begin
  Result := ListLn;
end;

function TStrList.getstring(index: integer): string;
begin
//04062004:Shu
  if (length(vList) > 0) and (index >= low(vList)) and (index <= high(vList)) then
    result := vList[index];
//04062004:Shu-Raise an exception in else if you want to
end;

procedure TStrList.setstring(index: integer; const Value: string);
begin
//04062004:Shu
  if (length(vList) > 0) and (index >= low(vList)) and (index <= high(vList)) then
    vList[index] := Value;
//04062004:Shu-Raise an exception in else if you want to
end;

end.
0
 
KLOPEKSAuthor Commented:
what can i add to it to make it support commatext
0
 
kretzschmarCommented:
add

property commatext : string read GetCommaText write SetCommaText;

implement
function GetCommaText : String;
procedure SetCommaText(AValue : String);

as you need


btw. you should keep the question by one question

meikl ;-)
0
 
KLOPEKSAuthor Commented:
i can just add
property commatext : string read GetCommaText write SetCommaText;
implement
function GetCommaText : String;
procedure SetCommaText(AValue : String);
 to my strlist  class?
0
 
snehanshuCommented:
to support commatext, you will need something like

private
function getcommatext: string;
procedure setcommatext(const Value: string);
...
public
property commatext:string read getcommatext write setcommatext;

...
function TStrList.getcommatext: string;
Var
  i: integer;

begin
//  generate commatext when required
  result := '';
  if length(vList) > 0 then
  Begin
    for i := low(vList) to high(vList) do
    begin
      result := result + vList[i];
      if i <> high(vList) then
      result := result + ',';
    end;
  End;

end;

procedure TStrList.setcommatext(const Value: string);
begin
//clear the current contents
//read commas in the string, separate the values
//add each comma separated value
//I am too tired to code this now, but I hope you get the idea :-)

end;
0
 
snehanshuCommented:
KLOPEKS,
There are a few things you would need to take care of in the get/set text code, like:
In TStringList, if some item already contains a comma, then in commatext, that value is enclosed in quotes
e.g.
if the four values in your list are
first
second
third,this string contains comma
fourth

then the commatext will be
first,second,"third,this string contains comma",fourth

so, you may want to take care of this when you write the code (for both read and write procedures).
like
function TStrList.getcommatext: string;
Var
  i: integer;

begin
//  generate commatext when required
  result := '';
  if length(vList) > 0 then
  Begin
    for i := low(vList) to high(vList) do
    begin
      if (pos(',',vList[i]) = 0) then
        result := result + vList[i]
      else
        result := result + '"'+vList[i]+'"';

      if i <> high(vList) then
      result := result + ',';
    end;
  End;

end;


HTH,
...Shu
0
 
snehanshuCommented:
oops,
too many posts without checking that meikl was already replying :-)
BTW, I agree with Meikl that
>>you should keep the question by one question
Cheers!
...Shu :-)
0
 
KLOPEKSAuthor Commented:
It works perfect, thanks and sorry for putting two question in one i'm outa points.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.