?
Solved

TStringList  Equivalent

Posted on 2004-04-05
20
Medium Priority
?
870 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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
 

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 660 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 does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Suggested Courses
Course of the Month14 days, 3 hours left to enroll

801 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