Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Автосортировка с выделением в ListBox


Автор: Keeper89 18.10.2009, 15:29
Доброго времени суток!

Делаю ListBox с автосортировкой:
user posted image
Код

procedure TForm2.Edit1Change(Sender: TObject);
var
  i: Integer;
begin
  ListBox1.Items.Clear;

  if Edit1.Text = EmptyStr then
    ListBox1.Items.Assign(sl)
  else

    for i := 0 to sl.Count - 1 do
    begin
      if AnsiPos(Edit1.Text, sl[i]) = 1 then
        ListBox1.Items.Add(sl[i]);
    end;

end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  sl := TStringList.Create();
  sl.Add('123wer456gn;');
  sl.Add('345wer45ttn;');
  sl.Add('123wfg45tygn;');
  sl.Add('12dfer45jhn;');
  Edit1.OnChange(Self);
end;



Вопрос такой: как выделить в Листбоксе жирным искомую часть? 
+ Может есть замечания по коду сортировки?  smile 

P.S. Такое, например, можно увидеть при наборе адреса в адресной строке Firefox.

Автор: Qu1nt 19.10.2009, 00:40
Наверное, сделал бы как-нибудь так:
Код

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Line, Bold: AnsiString;
  Count, Offset: Integer;
begin
  ListBox1.Style := lbOwnerDrawFixed; // !
  with ListBox1.Canvas do
  begin
    FillRect(Rect);
    Brush.Style := bsClear;
    Count := Length(Edit1.Text);
    Line := ListBox1.Items[Index];
    Offset := Rect.Left + 2;
    if Count > 0 then
    begin
      Bold := Copy(Line, 1, Count);
      Font.Style := [fsBold];
      TextOut(Offset, Rect.Top, Bold);
      Inc(Offset, TextWidth(Bold));
      Line := Copy(Line, Count + 1, Length(Line) - Count);
      Font.Style := [];
    end;
    TextOut(Offset, Rect.Top, Line);
  end;
end;

Автор: Alexeis 19.10.2009, 09:06
Пользуйтесь поиском http://forum.vingrad.ru/forum/topic-246193.html

Добавлено через 36 секунд
Внизу темы еще одна ссылка http://forum.vingrad.ru/topic-58882.html

Автор: Keeper89 21.10.2009, 15:51
Alexeis, в приведенный темах идет речь о выделении всего элемента, а я говорю только о части.

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

Автор: Qu1nt 22.10.2009, 02:10
Вроде придумал, вот:
Код

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
const
  FLAG = #1;
var
  Line, Bold: AnsiString;
  i: Integer;
begin
  with (Control as TListBox), Canvas do // Style = lbOwnerDrawFixed
  begin
    Line := Items[Index];
    Bold := Edit1.Text;
    Bold := StringReplace(Line, Bold, StringOfChar(FLAG, Length(Bold)),
      [rfReplaceAll, rfIgnoreCase]);
    FillRect(Rect);
    Brush.Style := bsClear;
    Inc(Rect.Left, 2);
    for i := 1 to Length(Line) do
    begin
      if Bold[i] = FLAG then
        Font.Style := [fsBold, fsUnderline];
      TextOut(Rect.Left, Rect.Top, Line[i]);
      Inc(Rect.Left, TextWidth(Line[i]));
      Font.Style := [];
    end;
  end;
end;

В примере выделяются все вхождения подстроки. 

Автор: Keeper89 22.10.2009, 21:21
Qu1nt, спасибо! Закрываю тему.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)