ComboBox с фильтром

[СергА]

Иногда в выпадающем списке содержится большое количество элементов, в этом случае, для удобства выбора пользователю удобно набрать пару-тройку букв и выбрать из уже небольшого списка подходящих элементов. Идея вобщем не нова и давно уже многими реализована, пост создаю для начинающих программистов, чтобы показать как можно использовать готовые классы и дополнять их новыми возможностями. Заодно готов выслушать критику от опытных программистов.

Код Combobox'а с фильтром:

unit uFiltrComboBox;
 
interface
uses Winapi.Windows, Winapi.Messages, Vcl.Controls, System.Classes, Vcl.StdCtrls;
const alphUp='ABCDEFGHIJKLMNOPQRSTUVWXYZАБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
      alphDn='abcdefghijklmnopqrstuvwxyzабвгдеёжзийклмнопрстуфхцчшщъыьэюя';
type
TFiltrCombobox=class(TCustomComboBox)
  private
   AllList:TStringList;
   Filtr:string;
   function meUpCase(s:string):string;
   procedure upDateList;
  protected
   procedure KeyDown(var Key: Word; Shift: TShiftState); override;
   procedure KeyPress(var Key: Char); override;
   procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy;   override;
   procedure setFiltr(filtr:string);
   function getFiltr:string;
   procedure addToAllList(s:string);
   procedure clearAllList;
end;
implementation
 
constructor TFiltrCombobox.Create(AOwner: TComponent);
//var f:textfile;
begin
 inherited create(AOwner);
 AllList:=TStringList.Create;
 self.Filtr:='';
 
{ assignfile(f,'debug.txt');
 rewrite(f);
 closefile(f);
}
end;
 
destructor TFiltrCombobox.Destroy;
begin
 AllList.Clear;
 AllList.Destroy;
 inherited Destroy;
end;
 
function TFiltrCombobox.getFiltr:string;
begin
  result:=self.Filtr;
end;
procedure TFiltrCombobox.clearAllList;
begin
  self.AllList.Clear;
  self.upDateList;
end;
 
procedure TFiltrCombobox.addToAllList(s:string);
begin
  self.AllList.Add(s);
  self.upDateList;
end;
procedure TFiltrCombobox.KeyDown(var Key: Word; Shift: TShiftState);
begin
 inherited KeyDown(Key, Shift);
end;
procedure TFiltrCombobox.KeyUp(var Key: Word; Shift: TShiftState);
begin
 inherited KeyUp(Key, Shift);
end;
procedure TFiltrCombobox.KeyPress(var Key: Char);
var s:string;
    _text:string;
    _selStart,_selLength:integer;
 {   f:textfile;
    texttofile:string;}
begin
 inherited KeyPress(Key);
 
 _text:=Text; _selStart:=selStart; _selLength:=selLength;
 s:=self.Text;
 if key=#0 then begin // если нажатие кнопки обработали, то ...
  if selLength>0 then delete(s,SelStart+1,selLength);
 end
 else begin // если нажатие кнопки не обработали, то ...
  insert(key,s,SelStart+1);
 end;
 
{ assignfile(f,'debug.txt');
 append(f);
 texttofile:=' "'+text+'"';
 writeln(f,'#',ord(key),texttofile:50,(SelStart+1):10,selLength:10,'"',s,'"');
 closefile(f);
}
 
 self.setFiltr(s);
 Perform(CB_SHOWDROPDOWN, 1, 0);
 
 Text:=_text; selStart:=_selStart; selLength:=_selLength;
 
 
 
end;
 
procedure TFiltrCombobox.setFiltr(filtr:string);
begin
 self.Filtr:=meUpCase(filtr);
 self.upDateList;
end;
function TFiltrCombobox.meUpCase(s:string):string;
var i,l,ipos:integer;
begin
 l:=length(s);
 for i := 1 to l do begin
   ipos:=pos(s[i],alphDn);
   if ipos<>0 then s[i]:=alphUp[ipos];
 end;
 Result:=s;
end;
 
procedure TFiltrCombobox.upDateList;
var s2,s,filtrUP:string;
    b:boolean;
    i:integer;
begin
 b:=(filtr<>'');
 if b then filtrUP:=meUpCase(filtr);
 Items.Clear;
 for I := 0 to AllList.Count-1 do begin
  s:=AllList.Strings[i];
  if b then begin
   s2:=meUpCase(s);
   if (pos(filtrUP,s2)<>0) then Items.Add(s);
  end
  else Items.Add(s);
 end;
 
end;
 
end.

Здесь в комментариях оставил код для отладки процесса фильтрации

Код основного модуля, как его подключать:

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,uFiltrComboBox;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FiltrBox:TFiltrComboBox;
  public
    { Public declarations }
   procedure FillFiltrBox;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FillFiltrBox;
begin
  FiltrBox.addToAllList('Абакумов');
  FiltrBox.addToAllList('Авакин');
  FiltrBox.addToAllList('Авриков');
  FiltrBox.addToAllList('Авакян');
  FiltrBox.addToAllList('Чебышев');
  FiltrBox.addToAllList('Реж');
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 FiltrBox:=TFiltrComboBox.Create(Form1);
 FiltrBox.SetBounds(50,50,200,20);
 self.InsertControl(FiltrBox);
 FillFiltrBox;
end;
 
 
end.

[Fr0sT]

Корявенько, в образцы кода не взял бы. Но принципиально по-другому и не сделаешь - контрол довольно дурацкий

[leo]

Для поиска строки по первым символам есть стандартное средство: Sorted + AutoComplete + AutoDropDown.
А поиск по любому вхождению - это уже экзотика, для которой логичнее добавить к комбобоксу специальную кнопочку для вызова диалога расширенного поиска строки (с опциями и наворотами насколько хватит фантазии и терпения\трудолюбия )

[DimaBr]

Замечания.
1. Использование self в коде лишнее
2. Взаимодействие с фильтром нужно через property Filter
3. Методы KeyDown, KeyUp лишние
4. При открытом списке вводим первые буквы и видим как список значений уменьшается, а размер выпадающего списка нет

[СергА]

к leo
у нас некоторые пользователи запоминают не начальную часть, а середину, поэтому решил сделать так
к DimaBr
про Self понятно, просто иногда удобно им пользоваться чтобы не вспоминать или не набирать полностью названия полей.
по 2-му спасибо за подсказку
по остальным пунктам - не заметил ( тоже спасибо )

[DimaBr]

После ввода трёх букв АВА, остаётся пустое поле выпадающего списка


Что делают эти методы ?

procedure TFiltrCombobox.KeyDown(var Key: Word; Shift: TShiftState);
begin
 inherited KeyDown(Key, Shift);
end;
 
procedure TFiltrCombobox.KeyUp(var Key: Word; Shift: TShiftState);
begin
 inherited KeyUp(Key, Shift);
end;

Сообщение отредактировано: DimaBr - 16.01.17, 05:05

[СергА]

да, я понял ваши замечания
keyDown и keyUp появились в результате написания кода (поначалу решил, что пригодятся), потом оптимизировал код и не заметил, что их можно просто удалить

Сообщение отредактировано: СергА - 16.01.17, 08:18