We help IT Professionals succeed at work.

Searching In Delphi

rperies
rperies asked
on
Hi, I'm trying to search through an array of strings (It's a field within a record, but for the purposes of this question, let's assume it's simply an array of strings) now I have an editbox called NameEdit which accepts a user-entered string.

What I want to do is for the program to search through the array and find complete and partial matches for the user-entered string. For instance, If NameArray[1] = Roger and NameArray[2] = Ryan, and the user searches for R, both Roger and Ryan should be added to the listbox NameLB. Now I've tried something that went like
If String > Namearray[1] (This was in a FOR loop, actually)


Comment
Watch Question

Author

Commented:
But the one I tried did all crazy stuff and returned inconsistent results...

So what I need is: A procedure that finds and returns partial and complete matches

thanks

rp

Commented:
Hi there,

You could do the follwing:

  lsSearch := NameEdit.Text;
  for liName := 0 to liArrayLength-1 do
  begin
    if AnsiCompareText(Copy(NameArray[liName], 1, Length(lsSearch), lsSearch) = 0 then
    begin
      Memo1.Lines.Add('Found match: ' + NameArray[liName]);
    end;
  end;

The AnsiCompareText make your routine case insensitive.

Regards Jacco
instead of AnsiCompare and the copy function just use the AnsiPos function which return the first occurence of the substring

like :

function ListResults(const SearchString: string; MyArray: TMyArray; var List: TStrings): Integer;
var I: Integer;
begin
  List.Clear;
  for I:=Low(MyArray) to High(MyArray) do
    if AnsiPos(SearchString, MyArray[I]) > 0 then
      List.Add(MyArray[I]);
  Result:=List.Count;
end;
Commented:
Here's a unit that compares/rates strings, using a percentage similarity system. There's also a routine
that'll take a string like 'R', compare it with an array of strings, and sort the the array of strings in order of
similarity to the string (e.g 'R').

You'll need to customize it slightly if you ONLY wanna return strings that contain the searched-for string. You could do this by adding a function that takes a threshold value like 20 and filter the array of strings, returning only those strings that rank above 20%

Anyway, here it is (note: this is a quick translation of my VB module, so it *could* be buggy - well, maybe just a couple syntax errors :)



unit RateStr;

interface

uses
  System, SysUtils;

type
  TRateInfo = record
    StrIndex: Integer;
    RatValue: Single;
  end;

  TRateInfoArray = array of TRateInfo;

//RateStrings returns a percentage (0-100) that reflects the similarity of the two strings passed to it
function RateStrings(str1, str2: string; seecase: boolean): Single;
//RateSortStrings rates a string with an array of strings and sorts the array according to similarity
procedure RateSortStrings(str1: string; var strlist: array of string; Ascending, seecase: boolean);

implementation

//forward declarations

function RateChar(ch: char; strg: string; ps: integer): Single; forward;
procedure BubbleSortRateInfoList(var tosort: array of TRateInfo; Ascnd: boolean = true); forward;

//actual implementation:

function RateStrings(str1, str2: string; seecase: boolean): Single;
var
  i, l1, l2, p1, p2: integer;
  chaRate, lenRate: Single;
begin
  result := 0;
  l1 := Length(str1);
  l2 := Length(str2);
  if not seecase then
  begin
    str1 := LowerCase(str1);
    str2 := LowerCase(str2);
  end;
  chaRate := 0;
  for i := 1 to l1 do
    chaRate := chaRate + RateChar(str1[i],str2,i);
  chaRate := chaRate/l1;
  if l1 > l2 then
    i := l1
  else
    i := l2;
  lenRate := 100 - ((Abs(l1-l2)/i)*100);
  RateStrings := ((chaRate+lenRate)/200)*100;
end;

function RateChar(ch: char; strg: string; ps: integer): Single;

  function Rspos(const findchar: char; const searchstr: string; const startpos: integer): integer;
  var
    i: integer;
  begin
    result := 0;
    for i := startpos downto 1 do
      if searchstr[i] = findchar then
      begin
        result := i;
        break;
      end;
  end;

  function Lspos(const findchar: char; const searchstr: string; const startpos: integer): integer;
  var
    i: integer;
  begin
    result := 0;
    for i := startpos to length(searchstr) do
      if searchstr[i] = findchar then
      begin
        result := i;
        break;
      end;
  end;

var
  l, r, lns: integer;
begin
  if strg[ps] = ch then
    result := 100
  else
  begin
    l := -1;
    r := -1;
    lns := length(strg);
    if ps > 1 then l := Rspos(ch,strg,ps-1);
    if ps < lns then r := Lspos(ch,strg,ps+1);
    if (l > 0) and (r > 0) then
    begin
      l := ps - l;
      r := r - ps;
      if l < r then
        ps := l
      else
        ps := r;
    end
    else
    begin
      if l > 0 then
        ps := ps - l
      else
        ps := r - ps;
    end;
    result := 100 - ((ps/lns)*100);
  end;
end;

procedure RateSortStrings(str1: string; var strlist: array of string; Ascending, seecase: boolean);
var
  l, u, i: integer;
  ri: TRateInfo;
  rates: TRateInfoArray;
  tempstrlist: array of string;
begin
  l := 0; //Low(strlist)
  u := High(strlist);
  SetLength(rates,u+1);
  for i := l to u do
  begin
    ri.StrIndex := i;
    ri.RatValue := RateStrings(str1,strlist[i],seecase);
    rates[i] := ri;
  end;
  BubbleSortRateInfoList(rates,Ascending);
  tempstrlist := Copy(strlist,l,u);
  for i := l to u do
    strlist[i] := tempstrlist[rates[i].StrIndex];
end;

procedure BubbleSortRateInfoList(tosort: TRateInfoArray; Ascnd: boolean = true);
var
  lb, ub, i: integer;
  ri1, ri2: TRateInfo;
  anybubbles: boolean;
begin
  ub := High(tosort);
  lb := 0; //Low(tosort);
  anybubbles := true;
  while anybubbles do
  begin
    anybubbles := false;
    for i := lb to ub do
    begin
      ri1 := tosort[i];
      if (i+1) > ub then break;
      ri2 := tosort[i+1];
      if (Ascnd and (ri2.RatValue < ri1.RatValue)) or ((not Ascnd) and (ri2.RatValue > ri1.RatValue)) then
      begin
        anybubbles := true;
        tosort[i] := ri2;
        tosort[i+1] := ri1;
      end;
    end;
  end;
end;

end.