2011-03-28 88 views
15

我想创建一个编辑框,我希望它能够自动附加输入时输入的文本。文本会附加文本文件中的“建议”。自动追加/从文本文件完成到编辑框德尔福

比方说,我在我的建议文件中有这些: 梦露 马龙·白兰度 麦克·梅尔斯

正如我开始在编辑框中键入“M”,其余的将突出显示(或没有): “arilyn Monroe” 当我继续输入“Mi”时,“ke Myers”会出现在最后。我希望我能够为你们做足够清楚!谢谢你的帮助!

+2

类似也http://stackoverflow.com/questions/2012208/google-like-edit-combo-control-for-delphi/ 2046649#2046649 – 2011-03-28 22:40:00

回答

12

您可以使用TComboBox轻松实现此功能。

请按照下列步骤操作:

  • 在表单中拖放组合框
  • 设置autocomplete属性为true
  • 设置sorted属性为true
  • 设置style属性csDropDown
  • OnExit事件的组合框中添加一个像这样的代码
const 
MaxHistory=200;//max number of items 


procedure TForm1.ComboBoxSearchExit(Sender: TObject); 
begin 
    //check if the text entered exist in the list, if not add to the list 
    if (Trim(ComboBoxSearch.Text)<>'') and (ComboBoxSearch.Items.IndexOf(ComboBoxSearch.Text)=-1) then 
    begin 
    if ComboBoxSearch.Items.Count=MaxHistory then 
    ComboBoxSearch.Items.Delete(ComboBoxSearch.Items.Count-1); 
    ComboBoxSearch.Items.Insert(0,ComboBoxSearch.Text); 
    end; 
end; 
  • 保存您的组合框的历史,例如在你 形式的OnClose事件
procedure TForm1.FormClose(Sender: TObject); 
begin 
    ComboBoxSearch.Items.SaveToFile(ExtractFilePath(ParamStr(0))+'History.txt'); 
end; 
  • 在窗体的OnCreate事件可以载入保存项目
procedure TForm1.FormCreate(Sender: TObject); 
var 
FileHistory : string; 
begin 
    FileHistory:=ExtractFilePath(ParamStr(0))+'History.txt'; 
    if FileExists(FileHIstory) then 
    ComboBoxSearch.Items.LoadFromFile(FileHistory); 
end; 
+0

谢谢!很容易! – Gab 2011-03-28 22:46:57

+3

不知道你为什么接受这个答案。肯的​​答案似乎是一个。除非你想要一个下拉。 – 2011-03-28 22:48:56

+0

@RRUZ:你被骗了。 :)问题是关于自动完成一个TEdit。好的回答,但是,比我能做的更快。 +1。 – 2011-03-28 22:49:53

40

您需要实现并注册IAutoComplete2

下面是它看起来像使用TEDIT(安德烈亚斯色调:)):

enter image description here enter image description here

更多信息 here ,包括示例代码以实现上述所有。

编辑:发布更新以提供TAutoCompleteEdit组件,注册单元,软件包源和快速示例应用程序的源代码。 (上面链接的站点似乎已经停止或已经消失。)在Delphi XE中进行编译和测试。复制上面的图像,除了使用ACStrings属性而不是TMemo来提供自动完成项目。

组分:

unit uAutoComplete; 

interface 

uses 
    Windows, SysUtils, Controls, Classes, ActiveX, ComObj, stdctrls, Forms, 
    Messages; 

const 
    IID_IAutoComplete: TGUID = '{00bb2762-6a77-11d0-a535-00c04fd7d062}'; 
    IID_IAutoComplete2: TGUID = '{EAC04BC0-3791-11d2-BB95-0060977B464C}'; 
    CLSID_IAutoComplete: TGUID = '{00BB2763-6A77-11D0-A535-00C04FD7D062}'; 

    IID_IACList: TGUID = '{77A130B0-94FD-11D0-A544-00C04FD7d062}'; 
    IID_IACList2: TGUID = '{470141a0-5186-11d2-bbb6-0060977b464c}'; 

    CLSID_ACLHistory: TGUID = '{00BB2764-6A77-11D0-A535-00C04FD7D062}'; 
    CLSID_ACListISF: TGUID = '{03C036F1-A186-11D0-824A-00AA005B4383}'; 
    CLSID_ACLMRU: TGUID = '{6756a641-de71-11d0-831b-00aa005b4383}'; 

type 

    IACList = interface(IUnknown) 
    ['{77A130B0-94FD-11D0-A544-00C04FD7d062}'] 
    function Expand(pszExpand : POLESTR) : HResult; stdcall; 
    end; 

const 
    //options for IACList2 
    ACLO_NONE = 0;   // don't enumerate anything 
    ACLO_CURRENTDIR = 1; // enumerate current directory 
    ACLO_MYCOMPUTER = 2; // enumerate MyComputer 
    ACLO_DESKTOP = 4;  // enumerate Desktop Folder 
    ACLO_FAVORITES = 8;  // enumerate Favorites Folder 
    ACLO_FILESYSONLY = 16; // enumerate only the file system 

type 
    IACList2 = interface(IACList) 
    ['{470141a0-5186-11d2-bbb6-0060977b464c}'] 
    function SetOptions(dwFlag: DWORD): HResult; stdcall; 
    function GetOptions(var pdwFlag: DWORD): HResult; stdcall; 
    end; 

    IAutoComplete = interface(IUnknown) 
    ['{00bb2762-6a77-11d0-a535-00c04fd7d062}'] 
    function Init(hwndEdit: HWND; const punkACL: IUnknown; 
     pwszRegKeyPath, pwszQuickComplete: POLESTR): HResult; stdcall; 
    function Enable(fEnable: BOOL): HResult; stdcall; 
    end; 

const 
    //options for IAutoComplete2 
    ACO_NONE = 0; 
    ACO_AUTOSUGGEST = $1; 
    ACO_AUTOAPPEND = $2; 
    ACO_SEARCH = $4; 
    ACO_FILTERPREFIXES = $8; 
    ACO_USETAB = $10; 
    ACO_UPDOWNKEYDROPSLIST = $20; 
    ACO_RTLREADING = $40; 

type 
    IAutoComplete2 = interface(IAutoComplete) 
    ['{EAC04BC0-3791-11d2-BB95-0060977B464C}'] 
    function SetOptions(dwFlag: DWORD): HResult; stdcall; 
    function GetOptions(out pdwFlag: DWORD): HResult; stdcall; 
    end; 

    TEnumString = class(TInterfacedObject, IEnumString) 
    private 
    FStrings: TStringList; 
    FCurrIndex: integer; 
    public 
    //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; 
    //VCL 
    constructor Create; 
    destructor Destroy;override; 
    end; 

    TACOption = (acAutoAppend, acAutoSuggest, acUseArrowKey); 
    TACOptions = set of TACOption; 

    TACSource = (acsList, acsHistory, acsMRU, acsShell); 

    TAutoCompleteEdit = class(TEdit) 
    private 
    FACList: TEnumString; 
    FEnumString: IEnumString; 
    FAutoComplete: IAutoComplete; 
    FACEnabled: boolean; 
    FACOptions: TACOptions; 
    FACSource: TACSource; 
    function GetACStrings: TStringList; 
    procedure SetACEnabled(const Value: boolean); 
    procedure SetACOptions(const Value: TACOptions); 
    procedure SetACSource(const Value: TACSource); 
    procedure SetACStrings(const Value: TStringList); 
    protected 
    procedure CreateWnd; override; 
    procedure DestroyWnd; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    published 
    property ACEnabled: boolean read FACEnabled write SetACEnabled; 
    property ACOptions: TACOptions read FACOptions write SetACOptions; 
    property ACSource: TACSource read FACSource write SetACSource; 
    property ACStrings: TStringList read GetACStrings write SetACStrings; 
    end; 

implementation 

{ IUnknownInt } 

function TEnumString.Clone(out enm: IEnumString): HResult; 
begin 
    Result := E_NOTIMPL; 
    Pointer(enm) := nil; 
end; 

constructor TEnumString.Create; 
begin 
    inherited Create; 
    FStrings := TStringList.Create; 
    FCurrIndex := 0; 
end; 

destructor TEnumString.Destroy; 
begin 
    FStrings.Free; 
    inherited; 
end; 

function TEnumString.Next(celt: Integer; out elt; 
    pceltFetched: PLongint): HResult; 
var 
    I: Integer; 
    wStr: WideString; 
begin 
    I := 0; 
    while (I < celt) and (FCurrIndex < FStrings.Count) do 
    begin 
    wStr := FStrings[FCurrIndex]; 
    TPointerList(elt)[I] := CoTaskMemAlloc(2 * (Length(wStr) + 1)); 
    StringToWideChar(wStr, TPointerList(elt)[I], 2 * (Length(wStr) + 1)); 
    Inc(I); 
    Inc(FCurrIndex); 
    end; 
    if pceltFetched <> nil then 
    pceltFetched^ := I; 
    if I = celt then 
    Result := S_OK 
    else 
    Result := S_FALSE; 
end; 

function TEnumString.Reset: HResult; 
begin 
    FCurrIndex := 0; 
    Result := S_OK; 
end; 

function TEnumString.Skip(celt: Integer): HResult; 
begin 
    if (FCurrIndex + celt) <= FStrings.Count then 
    begin 
    Inc(FCurrIndex, celt); 
    Result := S_OK; 
    end 
    else 
    begin 
    FCurrIndex := FStrings.Count; 
    Result := S_FALSE; 
    end; 
end; 

{ TACEdit } 

constructor TAutoCompleteEdit.Create(AOwner: TComponent); 
begin 
    inherited; 
    FACList := TEnumString.Create; 
    FEnumString := FACList; 
    FACEnabled := True; 
    FACOptions := [acAutoAppend, acAutoSuggest, acUseArrowKey]; 
end; 

procedure TAutoCompleteEdit.CreateWnd; 
var 
    Dummy: IUnknown; 
    Strings: IEnumString; 
begin 
    inherited; 
    if HandleAllocated then 
    begin 
    try 
     Dummy := CreateComObject(CLSID_IAutoComplete); 
     if (Dummy <> nil) and 
     (Dummy.QueryInterface(IID_IAutoComplete, FAutoComplete) = S_OK) then 
     begin 
     case FACSource of 
      acsHistory: Strings := CreateComObject(CLSID_ACLHistory) as 
      IEnumString; 
      acsMRU: Strings := CreateComObject(CLSID_ACLMRU) as 
      IEnumString; 
      acsShell: Strings := CreateComObject(CLSID_ACListISF) as 
      IEnumString; 
     else 
      Strings := FACList as IEnumString; 
     end; 
     if S_OK = FAutoComplete.Init(Handle, Strings, nil, nil) then 
     begin 
      SetACEnabled(FACEnabled); 
      SetACOptions(FACOptions); 
     end; 
     end; 
    except 
     //CLSID_IAutoComplete is not available 
    end; 
    end; 
end; 

procedure TAutoCompleteEdit.DestroyWnd; 
begin 
    if (FAutoComplete <> nil) then 
    begin 
    FAutoComplete.Enable(False); 
    FAutoComplete := nil; 
    end; 
    inherited; 
end; 

function TAutoCompleteEdit.GetACStrings: TStringList; 
begin 
    Result := FACList.FStrings; 
end; 

procedure TAutoCompleteEdit.SetACEnabled(const Value: Boolean); 
begin 
    if (FAutoComplete <> nil) then 
    begin 
    FAutoComplete.Enable(FACEnabled); 
    end; 
    FACEnabled := Value; 
end; 

procedure TAutoCompleteEdit.SetACOptions(const Value: TACOptions); 
const 
    Options : array[TACOption] of integer = (ACO_AUTOAPPEND, 
              ACO_AUTOSUGGEST, 
              ACO_UPDOWNKEYDROPSLIST); 
var 
    Option:TACOption; 
    Opt: DWORD; 
    AC2: IAutoComplete2; 
begin 
    if (FAutoComplete <> nil) then 
    begin 
    if S_OK = FAutoComplete.QueryInterface(IID_IAutoComplete2, AC2) then 
    begin 
     Opt := ACO_NONE; 
     for Option := Low(Options) to High(Options) do 
     begin 
     if (Option in FACOptions) then 
      Opt := Opt or DWORD(Options[Option]); 
     end; 
     AC2.SetOptions(Opt); 
    end; 
    end; 
    FACOptions := Value; 
end; 

procedure TAutoCompleteEdit.SetACSource(const Value: TACSource); 
begin 
    if FACSource <> Value then 
    begin 
    FACSource := Value; 
    RecreateWnd; 
    end; 
end; 

procedure TAutoCompleteEdit.SetACStrings(const Value: TStringList); 
begin 
    if Value <> FACList.FStrings then 
    FACList.FStrings.Assign(Value); 
end; 

end. 

登记单元:

unit AutoCompletEditReg; 

interface 

uses 
    uAutoComplete; 

procedure Register; 

implementation 

uses 
    Classes; 

procedure Register; 
begin 
    RegisterComponents('AutoComplete', [TAutoCompleteEdit]); 
end; 

end. 

包源:

package AutoCompleteEditPkg; 

{$R *.res} 
{$ALIGN 8} 
{$ASSERTIONS ON} 
{$BOOLEVAL OFF} 
{$DEBUGINFO ON} 
{$EXTENDEDSYNTAX ON} 
{$IMPORTEDDATA ON} 
{$IOCHECKS ON} 
{$LOCALSYMBOLS ON} 
{$LONGSTRINGS ON} 
{$OPENSTRINGS ON} 
{$OPTIMIZATION ON} 
{$OVERFLOWCHECKS OFF} 
{$RANGECHECKS OFF} 
{$REFERENCEINFO ON} 
{$SAFEDIVIDE OFF} 
{$STACKFRAMES OFF} 
{$TYPEDADDRESS OFF} 
{$VARSTRINGCHECKS ON} 
{$WRITEABLECONST OFF} 
{$MINENUMSIZE 1} 
{$IMAGEBASE $400000} 
{$IMPLICITBUILD ON} 

requires 
    rtl; 

contains 
    AutoCompletEditReg in 'AutoCompletEditReg.pas'; 

end. 

的检测单元和形式。 DFM文件:

object Form1: TForm1 
    Left = 0 
    Top = 0 
    Caption = 'Form1' 
    ClientHeight = 202 
    ClientWidth = 447 
    Color = clBtnFace 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    OnCreate = FormCreate 
    PixelsPerInch = 96 
    TextHeight = 13 
    object AutoCompleteEdit1: TAutoCompleteEdit 
    Left = 24 
    Top = 24 
    Width = 121 
    Height = 21 
    TabOrder = 0 
    Text = 'AutoCompleteEdit1' 
    ACEnabled = True 
    ACOptions = [acAutoAppend, acAutoSuggest, acUseArrowKey] 
    ACSource = acsList 
    ACStrings.Strings = (
     'and' 
     'array' 
     'as' 
     'asm' 
     'begin' 
     'case' 
     'class' 
     'const' 
     'constructor' 
     'destructor' 
     'dispinterface' 
     'div' 
     'do' 
     'downto' 
     'else' 
     'end' 
     'except' 
     'exports' 
     'file' 
     'finalization' 
     'finally' 
     'for' 
     'function' 
     'goto' 
     'if' 
     'implementation' 
     'in' 
     'inherited' 
     'initialization' 
     'inline' 
     'interface' 
     'is' 
     'label' 
     'library' 
     'mod' 
     'nil' 
     'not' 
     'object' 
     'of' 
     'or' 
     'out' 
     'packed' 
     'procedure' 
     'program' 
     'property' 
     'raise' 
     'record' 
     'repeat' 
     'resourcestring' 
     'set' 
     'shl' 
     'shr' 
     'string' 
     'then' 
     'threadvar' 
     'to' 
     'try' 
     'type' 
     'unit' 
     'until' 
     'uses' 
     'var' 
     'while' 
     'with' 
     'xor') 
    end 
end 

测试单元:

unit ACEditTestUnit; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, uAutoComplete; 

type 
    TForm1 = class(TForm) 
    AutoCompleteEdit1: TAutoCompleteEdit; 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

end. 
+2

+1就是这样:) – 2011-03-28 22:55:48

+10

必须记住这个以备将来参考 – 2011-03-29 01:23:29

+0

像Delphi7一样的魅力,没有任何修改! – Steve 2014-09-02 11:38:49