FAQ VCL
Компоненты\ListBox

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как добавить горизонтальную полосу прокрутки в TListBox?

// Этот код находит ширину, в пикселях, 
// самой длинной строки в окне списка.
// Два дополнительных пиксела добавлены к MaxWidth, 
// чтобы сдвинуть оконечные символы от правой границы окна списка.

procedure TForm1.FormCreate(Sender: TObject);
var
  i, MaxWidth: integer;
begin
   MaxWidth := 0;
   for i := 0 to ListBox1.Items.Count - 1 do
      if MaxWidth < ListBox1.Canvas.TextWidth( ListBox1.Items.Strings[i] ) then
         MaxWidth := ListBox1.Canvas.TextWidth( ListBox1.Items.Strings[i] );
   SendMessage( ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+2, 0 );
end;


Как поместить картинки в ListBox?

// ListBox1.Style = lbOwnerDrawFixed, при этом,
// на форме должен быть ImageList1 c набором иконок

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
   // Заполняем прямоугольник
   ListBox1.Canvas.FillRect( Rect );
   // Рисуем иконку
   ImageList1.Draw( ListBox1.Canvas, Rect.Left, Rect.Top, Index );
   // Пишем текст после иконки
   ListBox1.Canvas.TextOut( Rect.Left + ImageList1.Width + 2, Rect.Top,
   ListBox1.Items[Index] );
end;


Как в TListBox перетаскивать итемы?

// ListBox1.DragMode = dmAutomatic

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
   Accept := True;
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  NewIndex: integer;
begin
   with Sender as TListBox do
   begin
      NewIndex := ItemAtPos( Point( X, Y ), True );
      Items.Move( ItemIndex, NewIndex );
      ItemIndex:= NewIndex;
   end;
end;


Как осуществить быстрый поиск в ListBox?

// ListBox1.MultiSelect = false
// Этим способом можно искать не только по полному совпадению,
// но и по начальным символам строки.

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
   ListBox1.Perform( LB_SELECTSTRING, ListBox1.ItemIndex,
                     longint( Pchar( Edit1.text ) ) );
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
begin
   s := Edit1.Text;
   with ListBox1 do
      ItemIndex := Perform( LB_SELECTSTRING, ItemIndex, LongInt( s ) );
end;


Как показывать хинты для частично видимых элементов ListBox?

// ListBox1.ShowHint = true

var
  Form1: TForm1;
  OldIdx: Longint = -1;

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Idx: Longint;
begin
   with Sender as TListBox do
   begin
      Idx := ItemAtPos( Point( x, y ), True );
      if ( Idx < 0 ) or ( Idx = OldIdx ) then Exit;
      Application.ProcessMessages;
      Application.CancelHint;
      OldIdx := Idx;
      Hint := '';
      if Canvas.TextWidth( Items[Idx] ) > ( ( Sender as TListBox ).Width - 4 ) then
         Hint := Items[Idx];
    end;
end;


Как изменить фоновый цвет текста в различных строчках TListBox?

// TListBox.Style = lbOwnerDrawFixed
// Если не изменить свойство Style,
// то событие OnDrawItem никогда не вызовется.

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  myColor: TColor;
  myBrush: TBrush;
begin
   myBrush := TBrush.Create;
   with ( Control as TListBox ).Canvas do
   begin
      if not Odd( Index ) then
         myColor := clSilver
      else
         myColor := clYellow;
      myBrush.Style := bsSolid;
      myBrush.Color := myColor;
      Windows.FillRect( Handle, Rect, myBrush.Handle );
      Brush.Style := bsClear;
      TextOut( Rect.Left, Rect.Top, ( Control as TListBox ).Items[Index] );
      MyBrush.Free;
   end;
end;

// или немного по-другому
// TListBox.Style = lbOwnerDrawFixed

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
   With ListBox1 do
   begin
      if odSelected in State then
         Canvas.Brush.Color := clTeal
      else
         Canvas.Brush.Color := clWindow;
      Canvas.FillRect( Rect );
      Canvas.TextOut( Rect.Left + 2, Rect.Top, Items[Index] );
   end;
end;


Как из TListBox убрать вертикальный ScrollBar?

type
  TListBoxNoVScroll = class(TListBox)
  public
    procedure CreateParams( var Params: TCreateParams ); override;
  end;

var
  Form1: TForm1;
  MyListBox: TListBoxNoVScroll;

implementation

{$R *.dfm}

{ TListBoxNoVScroll }

procedure TListBoxNoVScroll.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams( Params );
   Params.Style := Params.Style and not WS_VSCROLL;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: byte;
begin
   MyListBox := TListBoxNoVScroll.Create( Self );
   MyListBox.Parent := Form1;
   for i := 0 to 50 do
      MyListBox.Items.Add( IntToStr( i ) );
   MyListBox.Show;
end;


Как выбрать пункт TListBox, когда мышь находится над ним?

procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   ListBox1.ItemIndex := ListBox1.ItemAtPos( Point( X, Y ), true );
end;


Как изменить шрифт в TListBox на моноширный?

// SYSTEM_FIXED_FONT или ANSI_FIXED_FONT

procedure TForm1.FormCreate(Sender: TObject);
begin
   SendMessage( ListBox1.Handle, WM_SETFONT,
                GetStockObject( SYSTEM_FIXED_FONT ), 1 );
end;


Как обработать щелчок мыши в пустой области TListBox?

// Способ первый
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then
   begin
      with Sender as TListBox do
      begin
         if ItemAtPos(Point(X, Y), True) = -1 then
            if ssDouble in Shift then
               ShowMessage('Двойной щелчок в пустой области ListBox');
      end;
   end;
end;

// Способ второй
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  p: TPoint;
begin
   GetCursorPos(p);
   if ListBox1.ItemAtPos(ListBox1.ScreenToClient(p), True) = -1 then
      ShowMessage('Двойной щелчок в пустой области ListBox');
end;

При использовании материала - ссылка на сайт обязательна