Solved

TStringList  Equivalent

Posted on 2004-04-05
20
857 Views
Last Modified: 2008-03-17
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.
0
Comment
Question by:KLOPEKS
  • 7
  • 5
  • 4
  • +1
20 Comments
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10759388
Use
 
 S:= L.Strings(I);

Shane
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 10759628
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
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10759693
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
 

Author Comment

by:KLOPEKS
ID: 10760669
now it's giving me an error at

S.CommaText := function(TStrList);


0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 10760812
?? how did you implement it ??
if you has it implemented
0
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10760900
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
 

Author Comment

by:KLOPEKS
ID: 10761051
procedure TForm1.Button1Click(Sender: TObject);
var
  L: TStrList;
  L2: TStrList;
begin
  L := TStriList.Create;
  L2:= TStrList.Create;
  L2.CommaText := ProcessSearchRec (L);
 end;
end.
0
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10761098

 You are getting an error here?

  L2.CommaText := ProcessSearchRec (L);

 Can we see the function code (processSearchRec)

Shane
0
 

Author Comment

by:KLOPEKS
ID: 10761693
the result of processSearchRec is a TStriList
0
 
LVL 11

Expert Comment

by:shaneholmes
ID: 10761704
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
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:KLOPEKS
ID: 10763950
i get an error" left side cannot be assigned to"
0
 
LVL 5

Expert Comment

by:snehanshu
ID: 10764028
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
 

Author Comment

by:KLOPEKS
ID: 10764615
what can i add to it to make it support commatext
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 10764686
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
 

Author Comment

by:KLOPEKS
ID: 10764703
i can just add
property commatext : string read GetCommaText write SetCommaText;
implement
function GetCommaText : String;
procedure SetCommaText(AValue : String);
 to my strlist  class?
0
 
LVL 5

Expert Comment

by:snehanshu
ID: 10764740
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
 
LVL 27

Accepted Solution

by:
kretzschmar earned 165 total points
ID: 10764756
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
 
LVL 5

Expert Comment

by:snehanshu
ID: 10764800
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
 
LVL 5

Expert Comment

by:snehanshu
ID: 10764824
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
 

Author Comment

by:KLOPEKS
ID: 10764965
It works perfect, thanks and sorry for putting two question in one i'm outa points.
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now