要想完成这个功能，就必须得需要shell32.dll的支持，涉及到Shell外壳编程，在参考《Delphi深度探索》一书中的《实现AutoComplete》，原文讲述的十分清楚，可以在http://www.biye5u.com/article/prog/dephi/2011/3679.html看到此篇文章。现我把只需要用到的功能整理封装成一个类，如下：
| 001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020 021 022 023 024 025 026 027 028 029 030 031 032 033 034 035 036 037 038 039 040 041 042 043 044 045 046 047 048 049 050 051 052 053 054 055 056 057 058 059 060 061 062 063 064 065 066 067 068 069 070 071 072 073 074 075 076 077 078 079 080 081 082 083 084 085 086 087 088 089 090 091 092 093 094 095 096 097 098 099 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 |
{*******************************************************} { } { 系统名称 编辑框自动提示完成 } { 作者网址 http://blog.csdn.net/akof1314 } { 单元名称 UnitAutoComplete.pas } { 单元功能 绑定编辑框，使之关联字符串，可联想提示 } { } {*******************************************************} unit UnitAutoComplete; interface uses Windows, Classes, StdCtrls, ActiveX, ShlObj, ComObj; const { IAutoComplete2 options } ACO_NONE = 0; //无自动完成功能 ACO_AUTOSUGGEST = $1; //自动显示下拉列表 ACO_AUTOAPPEND = $2; //自动添加完成项 ACO_SEARCH = $4; //在下拉列表多一个搜索项 ACO_FILTERPREFIXES = $8; //防止自动完成匹配常用前缀比如"www.", "http://"等 ACO_USETAB = $10; //用TAB键在下拉列表中选择 ACO_UPDOWNKEYDROPSLIST = $20; //上下按键可以用来调出下拉列表框 ACO_RTLREADING = $40; //按由右到左的顺序读 type TEnumString = class(TInterfacedObject, IEnumString) private FStrings: TStrings; FIndex: Integer; protected { IEnumString } function Next(celt: Longint; out elt; pceltFetched: PLongint): HResult; stdcall; function Skip(celt: Longint): HResult; stdcall; function Reset: HResult; stdcall; function Clone(out enm: IEnumString): HResult; stdcall; public constructor Create(Strings: TStrings); end; TAutoComplete = class private // protected // public class procedure EnableAutoComplete(edt: TCustomEdit;sl: TStrings;dwFlag: DWORD); end; implementation constructor TEnumString.Create(Strings: TStrings); begin inherited Create; FStrings := Strings; end; { TEnumString.IEnumString } function TEnumString.Next(celt: Longint; out elt; pceltFetched: PLongint): HResult; var I: Integer; begin I := 0; while (I < celt) and (FIndex < FStrings.Count) do begin TPointerList(elt)[I] := PWideChar(WideString(FStrings[FIndex])); Inc(I); Inc(FIndex); end; if pceltFetched <> nil then pceltFetched^ := I; if I = celt then Result := S_OK else Result := S_FALSE; end; function TEnumString.Skip(celt: Longint): HResult; begin if (FIndex + celt) <= FStrings.Count then begin Inc(FIndex, celt); Result := S_OK; end else begin FIndex := FStrings.Count; Result := S_FALSE; end; end; function TEnumString.Reset: HResult; begin FIndex := 0; Result := S_OK; end; function TEnumString.Clone(out enm: IEnumString): HResult; begin try enm := TEnumString.Create(FStrings); Result := S_OK; except Result := E_UNEXPECTED; end; end; {------------------------------------------------------------------------------- 过程名: TAutoComplete.EnableAutoComplete 功能: 自动完成 参数: edt: TCustomEdit;sl: TStrings;dwFlag: DWORD 返回值: 无 -------------------------------------------------------------------------------} class procedure TAutoComplete.EnableAutoComplete(edt: TCustomEdit;sl: TStrings;dwFlag: DWORD); var FAutoComplete: IAutoComplete2; FStrings: IUnknown; begin FAutoComplete := CreateComObject(CLSID_AutoComplete) as IAutoComplete2; FStrings := TEnumString.Create(sl) as IUnknown; OleCheck(FAutoComplete.SetOptions(dwFlag)); OleCheck(FAutoComplete.Init(edt.Handle, FStrings, nil, nil)); end; end. |
要使用的话，只需要调用TAutoComplete.EnableAutoComplete过程就可以了，如下测试：
| 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 |
uses UnitAutoComplete; {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var FStrings: TStrings; begin FStrings := TStringList.Create; FStrings.Add('无幻'); FStrings.Add('无幻博客'); FStrings.Add('无幻欢迎你'); FStrings.Add('CSDN社区'); TAutoComplete.EnableAutoComplete(edt1, FStrings, ACO_AUTOSUGGEST + ACO_UPDOWNKEYDROPSLIST); end; |