首页  编辑  

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

Tags: /超级猛料/VCL/(Check|List|ComBo)BOX/   Date Created:

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.