类似IE地址栏的自动完成的效果

unit CompletingComboBox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TCompletingComboBox = class(TComboBox)
private
FTextCompletion: Boolean;
function GetTextCompletion: Boolean;
procedure SetTextCompletion(const Value: Boolean);
protected
// override the WndProc() so that we can trap KeyUp events.
procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
ComboProc: Pointer); override;
public
{ Public declarations }
published
property TextCompletion: Boolean read GetTextCompletion write SetTextCompletion;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TCompletingComboBox]);
end;
{ TCompletingComboBox }
function TCompletingComboBox.GetTextCompletion: Boolean;
begin
Result := fTextCompletion;
end;
procedure TCompletingComboBox.SetTextCompletion(const Value: Boolean);
begin
fTextCompletion := Value;
end;
procedure TCompletingComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
ComboProc: Pointer);
var
rc, len: Integer;
begin
inherited;
case Message.Msg of
WM_KEYUP:
begin
// test to see if its a character that should not be processed.
if (Message.WParam <> 8) and (Message.WParam <> VK_DELETE) and
(Message.WParam <> VK_SHIFT) and (FTextCompletion = True) then
begin
// Use CB_FINDSTRING to locate the string in the Items property
rc := Perform(CB_FINDSTRING, -1, Integer(PChar(Caption)));
// if its in there then add the new string to the Text and
// select the portion that wasn't typed in by the user
if rc <> CB_ERR then
begin
// store the length of the current string
len := Length(Text);
// set the new string
ItemIndex := rc;
// highlight the rest of the text that was added.
SelStart := len;
SelLength := Length(Text) - len;
　
// return 0 to signify that the message has been handled.
Message.Result := 0;
end;
end;
end;
end; // case
end;
end.
*************************
Combobox的自动完成
在Combobox的OnChange或者Key事件中，写如下代码，注意，没有处理删除的情况，请自己完成。
procedure TForm1.ComboBox1Change(Sender: TObject);
var
a:integer;
Old:string;
begin
a:=-1;
Old :=ComboBox1.Text;
sendmessage(combobox1.handle,CB_SHOWDROPDOWN,1,0);
a:=SendMessage(ComboBox1.Handle, CB_SELECTSTRING,integer(@a),integer(pchar(ComboBox1.Text)));
ComboBox1.SelStart:=Length(Old);
ComboBox1.SelLength:=Length(ComboBox1.Text)-Length(Old);
ComboBox1.ItemIndex:=a;
end;
***********
unit unit1
....
private
selectitem : boolean;
....
procedure TForm1.ComboBox1Change(Sender: TObject);
var
sinput, sselected : string;
i, j : integer;
begin
j := 0;
if not selectitem then
begin
selectitem := true;
exit;
end;
sinput := copy(combobox1.text, 1, combobox1.SelStart);
for i := 0 to combobox1.items.count - 1 do
if copy(combobox1.items, 1, length(sinput)) = sinput then
begin
if j = 0 then sselected := combobox1.items;
j := j + 1;
end;
if j > 0 then combobox1.Text := sselected
else combobox1.Text := sinput;
combobox1.SelStart := length(sinput);
combobox1.SelLength := length(combobox1.text) - length(sinput);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
application.Terminate
end;
procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key = 8 then selectitem := false;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
selectitem := true;
end;
end.