На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Обязательно выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.

Этот раздел предназначен для вопросов, посвященных разработке компонентов, а также для тестирования собственных бесплатных компонентов с открытым исходным кодом.

Здесь запрещается:
1. Размещать ссылки на какие-либо коммерческие компоненты, реализующие требуемую функциональность.
2. Обсуждать и тестировать коммерческие компоненты или компоненты с закрытым кодом.
3. Давать ссылки на сайты с исходным кодом компонентов. Все тестируемые исходные коды должы быть размещены на сайте ИСХОДНИКИ.RU.
Модераторы: Rouse_, DimaBr
  
> ComboBox с фильтром
    Иногда в выпадающем списке содержится большое количество элементов, в этом случае, для удобства выбора пользователю удобно набрать пару-тройку букв и выбрать из уже небольшого списка подходящих элементов. Идея вобщем не нова и давно уже многими реализована, пост создаю для начинающих программистов, чтобы показать как можно использовать готовые классы и дополнять их новыми возможностями. Заодно готов выслушать критику от опытных программистов.

    Код Combobox'а с фильтром:
    ExpandedWrap disabled
      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.

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

    Код основного модуля, как его подключать:
    ExpandedWrap disabled
      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.
      Корявенько, в образцы кода не взял бы. Но принципиально по-другому и не сделаешь - контрол довольно дурацкий
        Для поиска строки по первым символам есть стандартное средство: Sorted + AutoComplete + AutoDropDown.
        А поиск по любому вхождению - это уже экзотика, для которой логичнее добавить к комбобоксу специальную кнопочку для вызова диалога расширенного поиска строки (с опциями и наворотами насколько хватит фантазии и терпения\трудолюбия :) )
          Замечания.
          1. Использование self в коде лишнее
          2. Взаимодействие с фильтром нужно через property Filter
          3. Методы KeyDown, KeyUp лишние
          4. При открытом списке вводим первые буквы и видим как список значений уменьшается, а размер выпадающего списка нет
            к leo
            у нас некоторые пользователи запоминают не начальную часть, а середину, поэтому решил сделать так
            к DimaBr
            про Self понятно, просто иногда удобно им пользоваться чтобы не вспоминать или не набирать полностью названия полей.
            по 2-му спасибо за подсказку
            по остальным пунктам - не заметил ( тоже спасибо :) )
              После ввода трёх букв АВА, остаётся пустое поле выпадающего списка
              user posted image

              Что делают эти методы ?
              ExpandedWrap disabled
                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 -
                да, я понял ваши замечания
                keyDown и keyUp появились в результате написания кода (поначалу решил, что пригодятся), потом оптимизировал код и не заметил, что их можно просто удалить
                Сообщение отредактировано: СергА -
                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                0 пользователей:


                Рейтинг@Mail.ru
                [ Script execution time: 0,0269 ]   [ 17 queries used ]   [ Generated: 19.03.24, 07:57 GMT ]