Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to make a combo box with fulltext search autocomplete support?

I would like a user to be able to type in the second or third word from a TComboBox item and for that item to appear in the AutoSuggest dropdown options

For example, a combo box contains the items:

  • Mr John Brown
  • Mrs Amanda Brown
  • Mr Brian Jones
  • Mrs Samantha Smith

When the user types "Br" the dropdown displays:

  • Mr John Brown
  • Mrs Amanda Brown
  • Mr Brian Jones

and when the user types "Jo" the dropdown displays:

  • Mr John Brown
  • Mr Brian Jones

The problem is that the AutoSuggest functionality only includes items in the dropdown list that begin with what the user has input and so in the examples above nothing will appear in the dropdown.

Is it possible to use the IAutoComplete interface and/or other related interfaces to get around this issue?

like image 711
Brendanator Avatar asked Feb 27 '12 14:02

Brendanator


4 Answers

The following example uses the interposed class of the TComboBox component. The main difference from the original class is that the items are stored in the separate StoredItems property instead of
the Items as usually (used because of simplicity).

The StoredItems are being watched by the OnChange event and whenever you change them (for instance by adding or deleting from this string list), the current filter will reflect it even when the combo
list is dropped down.

The main point here is to catch the WM_COMMAND message notification CBN_EDITUPDATE which is being sent whenever the combo edit text is changed but not rendered yet. When it arrives, you just search through the StoredItems list for what you have typed in your combo edit and fill the Items property with matches.

For text searching is used the ContainsText so the search is case insensitive. Forgot to mention,
the AutoComplete feature has to be turned off because it has its own, unwelcomed, logic for this purpose.

unit Unit1;

interface

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

type
  TComboBox = class(StdCtrls.TComboBox)
  private
    FStoredItems: TStringList;
    procedure FilterItems;
    procedure StoredItemsChange(Sender: TObject);
    procedure SetStoredItems(const Value: TStringList);
    procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property StoredItems: TStringList read FStoredItems write SetStoredItems;
  end;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TComboBox.Create(AOwner: TComponent);
begin
  inherited;
  AutoComplete := False;
  FStoredItems := TStringList.Create;
  FStoredItems.OnChange := StoredItemsChange;
end;

destructor TComboBox.Destroy;
begin
  FStoredItems.Free;
  inherited;
end;

procedure TComboBox.CNCommand(var AMessage: TWMCommand);
begin
  // we have to process everything from our ancestor
  inherited;
  // if we received the CBN_EDITUPDATE notification
  if AMessage.NotifyCode = CBN_EDITUPDATE then
    // fill the items with the matches
    FilterItems;
end;

procedure TComboBox.FilterItems;
var
  I: Integer;
  Selection: TSelection;
begin
  // store the current combo edit selection
  SendMessage(Handle, CB_GETEDITSEL, WPARAM(@Selection.StartPos),
    LPARAM(@Selection.EndPos));
  // begin with the items update
  Items.BeginUpdate;
  try
    // if the combo edit is not empty, then clear the items
    // and search through the FStoredItems
    if Text <> '' then
    begin
      // clear all items
      Items.Clear;
      // iterate through all of them
      for I := 0 to FStoredItems.Count - 1 do
        // check if the current one contains the text in edit
        if ContainsText(FStoredItems[I], Text) then
          // and if so, then add it to the items
          Items.Add(FStoredItems[I]);
    end
    // else the combo edit is empty
    else
      // so then we'll use all what we have in the FStoredItems
      Items.Assign(FStoredItems)
  finally
    // finish the items update
    Items.EndUpdate;
  end;
  // and restore the last combo edit selection
  SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos,
    Selection.EndPos));
end;

procedure TComboBox.StoredItemsChange(Sender: TObject);
begin
  if Assigned(FStoredItems) then
    FilterItems;
end;

procedure TComboBox.SetStoredItems(const Value: TStringList);
begin
  if Assigned(FStoredItems) then
    FStoredItems.Assign(Value)
  else
    FStoredItems := Value;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ComboBox: TComboBox;
begin
  // here's one combo created dynamically
  ComboBox := TComboBox.Create(Self);
  ComboBox.Parent := Self;
  ComboBox.Left := 10;
  ComboBox.Top := 10;
  ComboBox.Text := 'Br';

  // here's how to fill the StoredItems
  ComboBox.StoredItems.BeginUpdate;
  try
    ComboBox.StoredItems.Add('Mr John Brown');
    ComboBox.StoredItems.Add('Mrs Amanda Brown');
    ComboBox.StoredItems.Add('Mr Brian Jones');
    ComboBox.StoredItems.Add('Mrs Samantha Smith');
  finally
    ComboBox.StoredItems.EndUpdate;
  end;

  // and here's how to assign the Items of the combo box from the form 
  // to the StoredItems; note that if you'll use this, you have to do
  // it before you type something into the combo's edit, because typing 
  // may filter the Items, so they would get modified
  ComboBox1.StoredItems.Assign(ComboBox1.Items);
end;    

end.
like image 160
TLama Avatar answered Nov 12 '22 13:11

TLama


This code was quite good actually, I just fixed bug with handling messages when combo is dropped down, some minor interactions with TComboBox behavior and made it a little user-friendlier. To use it just invoke InitSmartCombo after filling the Items list.

TSmartComboBox is drop in replacement for TComboBox, if you invoke InitSmartCombo it behaves as smart combo, otherwise it acts as standard TComboBox

unit SmartCombo;

interface

uses stdctrls,classes,messages,controls,windows,sysutils;

type
  TSmartComboBox = class(TComboBox)
    // Usage:
    //   Same as TComboBox, just invoke InitSmartCombo after Items list is filled with data.
    //   After InitSmartCombo is invoked, StoredItems is assigned and combo starts to behave as a smart combo.
    //   If InitSmartCombo is not invoked it acts as standard TComboBox, it is safe to bulk replace all TComboBox in application with TSmartComboBox
  private
    FStoredItems: TStringList;
    dofilter:boolean;
    storeditemindex:integer;
    procedure FilterItems;
    procedure StoredItemsChange(Sender: TObject);
    procedure SetStoredItems(const Value: TStringList);
    procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
  protected
    procedure KeyPress(var Key: Char); override;
    procedure CloseUp; override;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property StoredItems: TStringList read FStoredItems write SetStoredItems;
    procedure InitSmartCombo;
  end;

implementation

procedure TSmartComboBox.KeyPress(var Key: Char);    // combo dropdown must be done in keypress, if its done on CBN_EDITUPDATE it messes up whole message processing mumbo-jumbo
    begin
      inherited;
      if dofilter and not (ord(key) in [13,27]) then begin
        if (items.Count<>0) and not droppeddown then SendMessage(Handle, CB_SHOWDROPDOWN, 1, 0)   // something matched -> dropdown combo to display results
      end;
    end;

procedure TSmartComboBox.CloseUp;     // ugly workaround for some wierd combobox/modified code interactions
var x:string;
    begin
      if dofilter then begin
        if (items.count=1) and (itemindex=0) then text:=items[itemindex]
        else if ((text<>'') and (itemindex<>-1) and (text<>items[itemindex])) or ((text='') and(itemindex=0)) then begin
          storeditemindex:=itemindex;
          x:=text;
          itemindex:=items.indexof(text);
          if itemindex=-1 then text:=x;
        end
        else storeditemindex:=-1;
      end;
      inherited;
    end;

procedure TSmartComboBox.Click;       // ugly workaround for some weird combobox/modified code interactions
    begin
      if dofilter then begin
        if storeditemindex<>-1 then itemindex:=storeditemindex;
        storeditemindex:=-1;
      end;
      inherited;
    end;

procedure TSmartComboBox.InitSmartCombo;
    begin
      FStoredItems.OnChange:=nil;
      StoredItems.Assign(Items);
      AutoComplete := False;
      FStoredItems.OnChange := StoredItemsChange;
      dofilter:=true;
      storeditemindex:=-1;
    end;

constructor TSmartComboBox.Create(AOwner: TComponent);
    begin
      inherited;
      FStoredItems := TStringList.Create;
      dofilter:=false;
    end;

destructor TSmartComboBox.Destroy;
    begin
      FStoredItems.Free;
      inherited;
    end;

procedure TSmartComboBox.CNCommand(var AMessage: TWMCommand);
    begin
      // we have to process everything from our ancestor
      inherited;
      // if we received the CBN_EDITUPDATE notification
      if (AMessage.NotifyCode = CBN_EDITUPDATE) and dofilter then begin
        // fill the items with the matches
        FilterItems;
      end;
    end;

procedure TSmartComboBox.FilterItems;
var
  I: Integer;
  Selection: TSelection;
    begin
      // store the current combo edit selection
      SendMessage(Handle, CB_GETEDITSEL, WPARAM(@Selection.StartPos), LPARAM(@Selection.EndPos));

      // begin with the items update
      Items.BeginUpdate;
      try
        // if the combo edit is not empty, then clear the items
        // and search through the FStoredItems
       if Text <> '' then begin
          // clear all items
          Items.Clear;
          // iterate through all of them
          for I := 0 to FStoredItems.Count - 1 do begin
            // check if the current one contains the text in edit, case insensitive
            if (Pos( uppercase(Text), uppercase(FStoredItems[I]) )>0) then begin
              // and if so, then add it to the items
              Items.Add(FStoredItems[I]);
            end;
          end;
        end else begin
          // else the combo edit is empty
          // so then we'll use all what we have in the FStoredItems
          Items.Assign(FStoredItems);
        end;
      finally
        // finish the items update
        Items.EndUpdate;
      end;
      // and restore the last combo edit selection

      SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
    end;

procedure TSmartComboBox.StoredItemsChange(Sender: TObject);
    begin
      if Assigned(FStoredItems) then
      FilterItems;
    end;

procedure TSmartComboBox.SetStoredItems(const Value: TStringList);
    begin
      if Assigned(FStoredItems) then
        FStoredItems.Assign(Value)
      else
        FStoredItems := Value;
    end;

procedure Register;
begin
  RegisterComponents('Standard', [TSmartComboBox]);
end;

end.
like image 30
mprot Avatar answered Nov 12 '22 12:11

mprot


Thanks for the heart! With a little reworking, I think that is quite right.

unit Unit1;

interface

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

type
  TComboBox = class(StdCtrls.TComboBox)
  private
    FStoredItems: TStringList;
    procedure FilterItems;
    procedure StoredItemsChange(Sender: TObject);
    procedure SetStoredItems(const Value: TStringList);
    procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property StoredItems: TStringList read FStoredItems write SetStoredItems;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{}constructor TComboBox.Create(AOwner: TComponent);
    begin
      inherited;
      AutoComplete := False;
      FStoredItems := TStringList.Create;
      FStoredItems.OnChange := StoredItemsChange;
    end;

{}destructor TComboBox.Destroy;
    begin
      FStoredItems.Free;
      inherited;
    end;

{}procedure TComboBox.CNCommand(var AMessage: TWMCommand);
    begin
      // we have to process everything from our ancestor
      inherited;
      // if we received the CBN_EDITUPDATE notification
      if AMessage.NotifyCode = CBN_EDITUPDATE then begin
        // fill the items with the matches
        FilterItems;
      end;
    end;

{}procedure TComboBox.FilterItems;
    type
      TSelection = record
        StartPos, EndPos: Integer;
      end;
    var
      I: Integer;
      Selection: TSelection;
      xText: string;
    begin
      // store the current combo edit selection
      SendMessage(Handle, CB_GETEDITSEL, WPARAM(@Selection.StartPos), LPARAM(@Selection.EndPos));

      // begin with the items update
      Items.BeginUpdate;
      try
        // if the combo edit is not empty, then clear the items
        // and search through the FStoredItems
        if Text <> '' then begin
          // clear all items
          Items.Clear;
          // iterate through all of them
          for I := 0 to FStoredItems.Count - 1 do begin
            // check if the current one contains the text in edit
    //      if ContainsText(FStoredItems[I], Text) then
            if Pos( Text, FStoredItems[I])>0 then begin
              // and if so, then add it to the items
              Items.Add(FStoredItems[I]);
            end;
          end;
        end else begin
          // else the combo edit is empty
          // so then we'll use all what we have in the FStoredItems
          Items.Assign(FStoredItems)
        end;
      finally
        // finish the items update
        Items.EndUpdate;
      end;

      // and restore the last combo edit selection
      xText := Text;
      SendMessage(Handle, CB_SHOWDROPDOWN, Integer(True), 0);
      if (Items<>nil) and (Items.Count>0) then begin
        ItemIndex := 0;
      end else begin
        ItemIndex := -1;
      end;
      Text := xText;
      SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));

    end;

{}procedure TComboBox.StoredItemsChange(Sender: TObject);
    begin
      if Assigned(FStoredItems) then
        FilterItems;
    end;

{}procedure TComboBox.SetStoredItems(const Value: TStringList);
    begin
      if Assigned(FStoredItems) then
        FStoredItems.Assign(Value)
      else
        FStoredItems := Value;
    end;

//=====================================================================

{}procedure TForm1.FormCreate(Sender: TObject);
    var
      ComboBox: TComboBox;
      xList:TStringList;
    begin

      // here's one combo created dynamically
      ComboBox := TComboBox.Create(Self);
      ComboBox.Parent := Self;
      ComboBox.Left := 8;
      ComboBox.Top := 8;
      ComboBox.Width := Width-16;
//    ComboBox.Style := csDropDownList;

      // here's how to fill the StoredItems
      ComboBox.StoredItems.BeginUpdate;
      try
        xList:=TStringList.Create;
        xList.LoadFromFile('list.txt');
        ComboBox.StoredItems.Assign( xList);
      finally
        ComboBox.StoredItems.EndUpdate;
      end;

      ComboBox.DropDownCount := 24;

      // and here's how to assign the Items of the combo box from the form
      // to the StoredItems; note that if you'll use this, you have to do
      // it before you type something into the combo's edit, because typing
      // may filter the Items, so they would get modified
      ComboBox.StoredItems.Assign(ComboBox.Items);
    end;

end.
like image 3
NikB Avatar answered Nov 12 '22 14:11

NikB


Added code for Unicode users.

Actually, it was only tested in Korean :(

Applied function

  • Prevents bugs that appear when OnExit or DropDown occurs while entering Unicode
  • Prevents bugs that occur when text correction or additional input after selecting an item

Modified code content

  • @Prevents a bug - typing values are appended when selecting a list while typing in Unicode
  • @Filtering is applied to each Unicode being typed if it is being entered after the end of the text.
  • @Exception handling in case of entering Unicode after selecting several texts
  • @Exception handling in case of additional input of Unicode when there is already a character in edit and the listbox is closed

Source...

unit SmartCombo;

interface

uses StdCtrls, Classes, Messages, Controls, Windows, SysUtils, StrUtils;

type
  TSmartComboBox = class(TComboBox)
    // Usage:
    // Same as TComboBox, just invoke InitSmartCombo after Items list is filled with data.
    // After InitSmartCombo is invoked, StoredItems is assigned and combo starts to behave as a smart combo.
    // If InitSmartCombo is not invoked it acts as standard TComboBox, it is safe to bulk replace all TComboBox in application with TSmartComboBox
  private
    FChar: Char; // @for UNICODE Filter
    FIgnoreChar: boolean; // @for UNICODE Edit
    FStoredItems: TStringList;
    doFilter: boolean;
    StoredItemIndex: Integer;

    procedure StoredItemsChange(Sender: TObject);
    procedure SetStoredItems(const Value: TStringList);
    procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
    function GetXText(var Key: Char): string;
    function GetXSelStart: Integer;
  protected
    procedure KeyPress(var Key: Char); override;

    // @Prevents a bug - typing values are appended when selecting a list while typing in Unicode
    procedure EditWndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure FilterItems;
    procedure InitSmartCombo;

    property StoredItems: TStringList read FStoredItems write SetStoredItems;
  end;

implementation

function TSmartComboBox.GetXText(var Key: Char): string;
var
  tmp: string;
begin
  if (Text = '') then // empty edit box
    result := ''
  else if SelLength > 0 then // has selection
  begin
    tmp := Copy(Text, SelStart + 1, SelLength);
    result := ReplaceStr(Text, tmp, '');
  end
  else // not empty edit box and no selection
  begin
    tmp := Copy(Text, 1, SelStart);
    result := tmp + Key;
    result := result + Copy(Text, SelStart + 1, Length(Text) - SelStart);
    Key := #0;
  end;
end;

function TSmartComboBox.GetXSelStart: Integer;
begin
  // empty edit box or has selection
  if (Text = '') or (SelLength > 0) then
    result := SelStart
  else // not empty edit box and no selection
    result := SelStart + 1;
end;

procedure TSmartComboBox.KeyPress(var Key: Char);
// combo dropdown must be done in keypress, if its done on CBN_EDITUPDATE it messes up whole message processing mumbo-jumbo
var
  xSelStart: Integer;
  xText: string;
begin
  inherited;

  if Ord(Key) = 8 then
    FChar := Key;

  if doFilter and not(Ord(Key) in [8, 13, 27]) then // BackSpace, Enter, ESC
  begin
    FChar := Key;

    if DroppedDown then
      Exit;

    if Items.Count = 0 then
      Exit;

    // backup
    xSelStart := GetXSelStart;
    xText := GetXText(Key);

    // dropdown
    SendMessage(Handle, CB_SHOWDROPDOWN, 1, 0);

    if xText.IsEmpty then
      Exit;

    // restore
    Text := xText;
    SelStart := xSelStart;
  end;
end;

procedure TSmartComboBox.InitSmartCombo;
begin
  FStoredItems.OnChange := nil;
  StoredItems.Assign(Items);
  AutoComplete := False;
  FStoredItems.OnChange := StoredItemsChange;
  doFilter := True;
  StoredItemIndex := -1;
end;

constructor TSmartComboBox.Create(AOwner: TComponent);
begin
  inherited;
  FStoredItems := TStringList.Create;
  FIgnoreChar := False;
  doFilter := False;
end;

destructor TSmartComboBox.Destroy;
begin
  FStoredItems.Free;
  inherited;
end;

procedure TSmartComboBox.EditWndProc(var Message: TMessage);
var
  OldText: string;
begin
  case Message.Msg of
    WM_IME_ENDCOMPOSITION:
      begin
        OldText := Self.Text;
        inherited;
        FIgnoreChar := Self.Text = OldText;
      end;
    WM_CHAR:
      begin
        FIgnoreChar := False;
        inherited;
      end;
    WM_IME_CHAR:
      begin
        if FIgnoreChar then
          FIgnoreChar := False
        else
          inherited;
      end;
  else
    inherited;
  end;
end;

procedure TSmartComboBox.CNCommand(var AMessage: TWMCommand);
begin
  // we have to process everything from our ancestor
  inherited;

  // @Filtering is applied to each Unicode being typed if it is being entered after the end of the text.
  // @If you are typing in the middle of the text, do not apply filtering to the Unicode being typed
  // (filtering is applied in units of completed Unicode characters)
  if (SelStart < Length(Text)) and (FChar = #0) then
    Exit;

  // if we received the CBN_EDITUPDATE notification
  if (AMessage.NotifyCode = CBN_EDITUPDATE) and doFilter then
  begin
    // fill the items with the matches
    FilterItems;
  end;

  FChar := #0;
end;

procedure TSmartComboBox.FilterItems;
var
  I: Integer;
  Selection: TSelection;
begin
  // store the current combo edit selection
  SendMessage(Handle, CB_GETEDITSEL, WPARAM(@Selection.StartPos), LPARAM(@Selection.EndPos));

  // begin with the items update
  Items.BeginUpdate;
  try
    // if the combo edit is not empty, then clear the items
    // and search through the FStoredItems
    if Text <> '' then
    begin
      // clear all items
      Items.Clear;
      // iterate through all of them
      for I := 0 to FStoredItems.Count - 1 do
      begin
        // check if the current one contains the text in edit, case insensitive
        if ContainsText(FStoredItems[I], Text) then
        begin
          // and if so, then add it to the items
          Items.Add(FStoredItems[I]);
        end;
      end;
    end
    else
    begin
      // else the combo edit is empty
      // so then we'll use all what we have in the FStoredItems
      Items.Assign(FStoredItems);
    end;
  finally
    // finish the items update
    Items.EndUpdate;
  end;

  // and restore the last combo edit selection
  SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;

procedure TSmartComboBox.StoredItemsChange(Sender: TObject);
begin
  if Assigned(FStoredItems) then
    FilterItems;
end;

procedure TSmartComboBox.SetStoredItems(const Value: TStringList);
begin
  if Assigned(FStoredItems) then
    FStoredItems.Assign(Value)
  else
    FStoredItems := Value;
end;

end.
like image 1
Jesse Lee Avatar answered Nov 12 '22 12:11

Jesse Lee