autocomplete - Auto append/complete from text file to an edit box delphi

Question

I'm trying to create an edit box and I want it to be able to auto-append the text entered while typing. Text would be appended with "suggestions" from a text file.

Let's say I have these in my suggestion file: Marilyn Monroe Marlon Brando Mike Myers

As I start typing "M" in the edit box, the remaining would appear highlighted(or not): "arilyn Monroe" And as I keep typing "Mi" then "ke Myers" would appear at the end. I hope I'm making this clear enough for you guys! Thanks for your help!

Answer 1

You need to implement and register IAutoComplete2.

Here's what it looks like using a TEdit ( shades of Andreas :) ):

More info here, including sample code to implement all of the above.

EDIT: Posting an update to provide source for a TAutoCompleteEdit component, a registration unit, package source, and a quick sample app. (The site linked above seems to be down or have disappeared.) Compiled and tested in Delphi XE. Replicates images above, except uses ACStrings property instead of TMemo to provide items for autocompletion.

The component:

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] := Pointer(wStr);
    Pointer(wStr) := nil;
    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. 

The registration unit:

unit AutoCompletEditReg;

interface

uses
  uAutoComplete;

procedure Register;

implementation

uses
  Classes;

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

end.

The package source:

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.

A test unit and form. The DFM file:

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
  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

The test unit:

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.