Auto append/complete from text file to an edit box

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

• Marilyn Monro

And as I keep typing Mi then "ke Myers" would appear at the end:

• Mike Myers

I hope I'm making this clear enough for you guys! Thanks for your help!

Ackley

Similar also to #2012708 – Principled

Similar to https://mcmap.net/q/437875/-how-to-make-a-combo-box-with-fulltext-search-autocomplete-support/5071605 , if you need to define the match function yourself – Brame

Answer 1

You can implement this feature easily using a TComboBox.

follow these steps :

• drop a combobox in your form
• set the autocomplete property to true
• set the sorted property to true
• set the style property to csDropDown
• in the OnExit event of the combobox add a code like this

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;

• Save the History of your combobox , for example in the OnClose event of your form

procedure TForm1.FormClose(Sender: TObject);
begin
   ComboBoxSearch.Items.SaveToFile(ExtractFilePath(ParamStr(0))+'History.txt');
end;

• in the Oncreate event of your form you can load the saved items

procedure TForm1.FormCreate(Sender: TObject);
var
 FileHistory  : string;
begin
   FileHistory:=ExtractFilePath(ParamStr(0))+'History.txt';
   if FileExists(FileHIstory) then
   ComboBoxSearch.Items.LoadFromFile(FileHistory);
end;

Harmless

don't know why you accepted this answer. Ken's answer seems to be the one. Unless you want a drop down. – Waxman

@RRUZ: You cheated. :) The question was about autocompleting a TEdit. Nice answer, though, and much quicker than I could make mine. +1. – Redcoat

@David, the answer is an alternative to use a TEdit component. I don't see any problem with that. – Harmless

I just like the true edit solution better. Your functions but the edit has more pleasing aesthetics although it takes more effort. Now I've got some more votes I can vote for it! :-) – Waxman

You could also set the style to csSimple. It won't show a drop down but still autocomplete. – Digenesis

Answer 2

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.

Redcoat

Must remember this for future reference – Quintessa

Works like charm with Delphi7 without any modifications! – Pyriphlegethon

Is it necessary to include the package source here? Especially when it should be split into two packages? It's using DesignIde... – Snare

This code is not using any functionality from the DesignIntf unit or the DesignIde package, so those references should be removed, then a design-time package will not be needed. – Succumb

@Remy I didn't even see the DesignIntf either, good catch. No design editors of any kind here. – Snare

For some reason the IEnumString.Next implementation didn't work for me in Delphi XE2. I took the implementation from the AxCtrls.pas TStringsEnumerator.Next. It works good. – Fordo

TEnumString.Next "Access Violation" for me also in D10.1/W10 at TPointerList. errors if I just do this: TPointerList(elt)[1] := CoTaskMemAlloc(8); Is something different after XE2? – Brame

@HenryCrun: [1] needs to be [I] – Succumb

@Eugene: the implementation works fine for me in XE2 if TPointerList(elt)[I] is changed to TPointerList(@elt)[I]. – Succumb

Also, I would suggest using ComObj.StringToLPOLEStr() to convert a String to a COM-allocated wide string: TPointerList(@elt)[I] := ComObj.StringToLPOLESTR(FStrings[FCurrIndex]); Alternatively, you can simply take ownership of the WideString pointer instead of making yet another copy after WideString already has made one: TPointerList(@elt)[I] := Pointer(wStr); Pointer(wStr) := nil; – Succumb

@RemyLebeau: Thanks for addressing those comments. I'm away from a compiler for a long weekend, but will look at integrating that last suggestion into my answer when I get back to one. – Redcoat

TPointerList(@elt)[I] := StringToLPOLESTR(FStrings[FCurrIndex]); is what works for me – Brame

@KenWhite A couple of questions when you do get to this... I am using this for comboboxes as well (primarily), Is there any way to make all the added code common to all the classes? I don't thin I can use helpers for get/sets. – Brame

@HenryCrun: I updated the code above to work in XE2 and Berlin (thanks to Remy's work in the comment above, it was easy). Your combobox question is too broad for a comment here. That should be a separate question in a new post. – Redcoat

Answer 3

This is more of a comment on the IAutoComplete solution. The current code sample will trigger an app crash if an empty string is present in the source list (only in the component version TAutoCompleteEdit, not the sample zip).

Using ComObj.StringToLPOLEStr() as suggested will fix it !

(tested in Delphi XE)

Photogene