A simple, small and not quite powerful, Internet Explorer like autosuggest
Assuming that you already know autocomplete, autosuggest is a feature of Internet Explorer 5.0 and above wich given an input shows possible matches in a list, these sample is not as powerful as the autosuggest of Internet Explorer but a good sample on how to implement a simple autosuggest.
This can be polished a bit more and perhaps when I have time some more time I will expand this, of course you can modify it, enhance it, etc. if you do let me know wich changes you made and why.
NOTES: This contains a form with 2 listboxes and a edit, fill ListBox1 with the strings you would like to search, Listbox2 will recive the probable matches
NOTES 2: This function uses David Souchard's Like procedure to determine a match (This was mainly because I was to emulate the behavior of Internet Explorer, was lazy to make a algorithm to do it, didnt have time, etc.)
<--------------------------------FORM CODE ------------------------------>
object frmAutocomplete: TfrmAutocomplete
Left = 192
Top = 121
Width = 544
Height = 375
ActiveControl = Edit1
Caption = 'frmAutocomplete'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 120
TextHeight = 16
object ListBox1: TListBox
Left = 32
Top = 16
Width = 185
Height = 281
ItemHeight = 16
TabOrder = 0
end
object ListBox2: TListBox
Left = 227
Top = 16
Width = 185
Height = 281
ItemHeight = 16
TabOrder = 1
end
object Edit1: TEdit
Left = 432
Top = 40
Width = 86
Height = 24
TabOrder = 2
OnChange = Edit1Change
end
end
<----------------------------------UNIT CODE --------------------------------->
unit uAutosuggest;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TSuggestThread = class( TThread )
protected
FSource, FDest: TStrings;
SuggestionText: String;
FResultCount:Integer;
procedure Execute; override;
public
constructor Create(ASource: TStrings; ADest: TStrings; const Base: String; AResultCount: Integer =100);
end;
TfrmAutocomplete = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
Edit1: TEdit;
procedure Edit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmAutocomplete: TfrmAutocomplete;
implementation
{$R *.DFM}
{ TSuggestThread }
constructor TSuggestThread.Create(ASource, ADest: TStrings;
const Base: String; AResultCount:Integer);
begin
inherited Create(False);
FreeOnTerminate := True;
FSource := ASource;
FDest := ADest;
SuggestionText := Base;
FResultCount := AResultCount;
end;
procedure TSuggestThread.Execute;
{This Like function was implemented by David Souchard
from latium software}
function Like(AString, Pattern: string): boolean;
var
i, n, n1, n2: integer;
p1, p2: pchar;
label
match, nomatch;
begin
AString := UpperCase(AString);
Pattern := UpperCase(Pattern);
n1 := Length(AString);
n2 := Length(Pattern);
if n1 < n2 then n := n1 else n := n2;
p1 := pchar(AString);
p2 := pchar(Pattern);
for i := 1 to n do begin
if p2^ = '*' then goto match;
if (p2^ <> '?') and (p2^ <> p1^) then goto nomatch;
inc(p1); inc(p2);
end;
if n1 > n2 then begin
nomatch:
Result := False;
exit;
end else if n1 < n2 then begin
for i := n1 + 1 to n2 do begin
if not (p2^ in ['*','?']) then goto nomatch;
inc(p2);
end;
end;
match:
Result := True;
end;
var
i: Integer;
begin
FDest.Clear;
for i := 0 to FSource.Count -1 do
begin
if Like(FSource[i], SuggestionText+'*') then
FDest.Add(FSource[i]);
if FDest.Count = FResultCount then
Break
end;
end;
procedure TfrmAutocomplete.Edit1Change(Sender: TObject);
begin
TSuggestThread.Create(ListBox1.Items, ListBox2.Items, Edit1.Text);
end;
end.