Title: TNavigatorComboBox : a smart combobox with text completion
Question: This new ComboBox act like the URL list of Netscape or IExplorer. It is inherited form TCustomComboBox.
Answer:
TNavigatorComboBox:
This component (installed in the 'Examples' tab) is designed to
act like the URL list of Netscape or IExplorer. When you enter the first letter of a string that match an other string, the whole string is typed and selected.
Use this component like a standard ComboBox. The strings to compare with are in the Items[] strings.
With this component, you can change the time before the matching string is replaced. You can also change the matching method (case sensitive or not).
I have seen other component doing this stuff in Delphi 3000. I have not used any of them to write my component. It is completly new.
(Written and tested on Delphi 3, NT4)
A sample program and a source code of the component is available.
// -- Source code begin here --//
unit T_NavigatorComboBox;
{**
** T_NavigatorComboBox.pas
** This component is a ComboBox object acting like
** the URL combo box of IE4 or Netscape : When the first
** char match, the most similar string is appened and
** selected.
**
** Usage
** Drop the T_NavigatorComboBox component. Add items in Items[] property.
** It will be used for matching.
**
** Property
** _interval : the interval, in ms, of which the matching string will appear
** 0 : act like a standard combo box
** _MatchMethod : method of matching (Exactly, case insensitive)
** _OnItemMatch : event when a item matching the string is found.
** _OnChange, _OnKeyDown : like the events of TComboBox
**
** V1.0 September 2000 - J.FORESTIER
**}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TMatchingMethod = (matchExactly,
matchCaseInsensitive,
matchCaseAnsiInsensitive,
matchCaseOEMInsensitive);
TMatchingEvent = procedure(Sender : TObject ; ItemIndex : integer) of object;
type
TNavigatorComboBox = class(TCustomComboBox)
private
{ Dclarations prives }
FTimerShow : TTimer;
FMatchMethod : TMatchingMethod;
FMatchMethodProc : function (const substr, str : string) : boolean ;
FOnItemMatch : TMatchingEvent;
GetOut : boolean;
// Turned methods
FOldComboChange : TNotifyEvent;
FOldComboKeyDown : TKeyEvent;
procedure SetInterval(interval : integer);
function GetInterval : integer;
procedure SetMatchMethod(mm : TMatchingMethod);
procedure OnComboChange(Sender : TObject);
procedure OnComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure OnTimer(Sender : TObject);
protected
{ Dclarations protges }
public
{ Dclarations publiques }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
property DroppedDown;
published
{ Dclarations publies }
property _Interval: Integer read GetInterval write SetInterval default 250;
property _MatchMethod : TMatchingMethod read FMatchMethod write SetMatchMethod;
property _OnChange : TNotifyEvent read FOldComboChange write FOldComboChange ;
property _OnKeyDown : TKeyEvent read FOldComboKeyDown write FOldComboKeyDown;
property _OnItemMatch : TMatchingEvent read FOnItemMatch write FOnItemMatch;
property Color;
property Ctl3D;
property DragMode;
property DragCursor;
property DropDownCount;
property Enabled;
property Font;
property ImeMode;
property ImeName;
property ItemHeight;
property Items;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDrag;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Exemples', [TNavigatorComboBox]);
end;
{** Matching method **}
function StrBeginWith_Exactly(const substr, str : string) : boolean;
// Return TRUE if str begin with substr
var
i : integer;
trouve : integer;
begin
if (str = '') or (substr = '') or (length(substr) length(str)) then
begin
result := false;
end
else
begin
trouve := 0;
for i := 1 to length(substr) do
begin
if (substr[i] = str[i]) then
begin
trouve := 1;
end
else
begin
trouve := 0;
break;
end;
end;
result := (trouve = 1);
end;
end;
procedure RemoveAccentEx(var str : string);
var
i : integer;
p : integer;
const
Accents = '';
NoAccents = 'AAAAAACEEEEIIIIDNOOOOOOUUUUYBaaaaaaceeeeiiiionoooooouuuuyby';
begin
for i := 1 to length(str) do
begin
p := pos(str[i], Accents);
if (p 0) then
str[i] := NoAccents[p];
end;
end;
function StrBeginWith_MatchCase(const substr, str : string) : boolean;
begin
result := StrBeginWith_Exactly(UpperCase(substr), UpperCase(str));
end;
function StrBeginWith_MatchCaseAnsi(const substr, str : string) : boolean;
var
S1, S2 : string;
begin
s1 := AnsiUpperCase(substr);
RemoveAccentEx(S1);
s2 := AnsiUpperCase(str);
RemoveAccentEx(S2);
result := StrBeginWith_Exactly(s1, s2);
end;
function StrBeginWith_MatchCaseOEM(const substr, str : string) : boolean;
var
s1, s2 : PCHAR;
begin
// This function is bugged...
GetMem(s1, length(substr) * sizeof(char));
GetMem(s2, length(str) * sizeof(char));
OemToChar(PCHAR(substr), s1);
OemToChar(PCHAR(str), s2);
result := StrBeginWith_Exactly(s1, s2);
Freemem(s1);
freemem(s2);
end;
constructor TNavigatorComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTimerShow := TTimer.Create(Self);
FTimerShow.Enabled := false;
FTimerShow.OnTimer := OnTimer;
SetMatchMethod(matchExactly);
SetInterval(250);
Style := csDropDown;
OnChange := OnComboChange;
OnKeyDown := OnComboKeyDown;
end;
destructor TNavigatorComboBox.Destroy;
begin
FTimerShow.Free;
FTimerShow := nil;
inherited Destroy;
end;
procedure TNavigatorComboBox.SetInterval(interval : integer);
begin
FTimerShow.Interval := interval;
end;
function TNavigatorComboBox.GetInterval : integer;
begin
result := FTimerShow.Interval;
end;
procedure TNavigatorComboBox.SetMatchMethod(mm : TMatchingMethod);
begin
FMatchMethod := mm;
case FMatchMethod of
matchExactly : FMatchMethodProc := StrBeginWith_Exactly;
matchCaseInSensitive : FMatchMethodProc := StrBeginWith_MatchCase;
matchCaseAnsiInSensitive : FMatchMethodProc := StrBeginWith_MatchCaseAnsi;
matchCaseOEMInSensitive : FMatchMethodProc := StrBeginWith_MatchCaseOEM;
end;
end;
procedure TNavigatorComboBox.OnComboChange(Sender : TObject);
begin
if (Assigned(FOldComboChange)) then
FOldComboChange(Sender);
FTimerShow.Enabled := false;
if (GetOut) then
begin
exit;
end;
GetOut := true;
FTimerShow.Enabled := true;
end;
procedure TNavigatorComboBox.OnComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (key = 8) then
begin
GetOut := true;
end
else
GetOut := false;
if (Assigned(FOldComboKeyDown)) then
FOldComboKeyDown(Sender, Key, Shift);
end;
procedure TNavigatorComboBox.OnTimer(Sender : TObject);
var
s : string;
t : string;
i : integer;
idx : integer;
{$IFDEF DEBUG}
TI : longint;
{$ENDIF}
begin
s := Text;
t := '';
idx := -1;
// Match
{$IFDEF DEBUG}
TI := GetTickCount;
{$ENDIF}
for i := 0 to Items.Count - 1 do
begin
if (FMatchMethodProc(s, Items[i])) then
begin
t := Items[i];
idx := i;
break;
end;
end;
if (idx -1) then
begin
if (FMatchMethod matchExactly) then
begin
Text := text + copy(t, length(text)+1, length(t));
end
else
begin
end;
ItemIndex := idx;
SelStart := Length(s);
SelLength := Length(t);
end;
{$IFDEF DEBUG}
TI := GetTickCount - TI;
Writeln(Format('TNavigatorComboBox.Match %s(%d) in %dms',[t, idx, TI]));
{$ENDIF}
if (Assigned(_OnItemMatch)) then
FOnItemMatch(self, idx);
GetOut := false;
FTimerShow.Enabled := false;
end;
end.