类似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[i], 1, length(sinput)) = sinput then

begin

if j = 0 then sselected := combobox1.items[i];

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.

此文章由 http://www.ositren.com 收集整理 ,地址为: http://www.ositren.com/htmls/68157.html