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

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

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

:: MVP ::

:: RSS ::

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

Как программно раскрыть TComboBox?

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
begin
   ComboBox1.DroppedDown := true;
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
   ComboBox1.Perform( CB_SHOWDROPDOWN, 1, 0 );
end;


Как опеделить состояние списка TComboBox, раскрыт/закрыт?

// Способ первый
// Timer1.Interval = 1
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if SendMessage( ComboBox1.Handle, CB_GETDROPPEDSTATE, 0, 0 ) = 1 then
      Form1.Caption := 'ComboBox раскрыт'
   else
      Form1.Caption := 'ComboBox закрыт';
end;

// Способ второй
// Timer1.Interval = 1
procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if ComboBox1.DroppedDown then
      Form1.Caption := 'ComboBox раскрыт'
   else
      Form1.Caption := 'ComboBox закрыт';
end;


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

// ComboBox1.Style = csOwnerDrawFixed, при этом,
// на форме должен быть ImageList1 c набором иконок
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
   // Заполняем прямоугольник
   ComboBox1.Canvas.FillRect( Rect );
   // Рисуем иконку
   ImageList1.Draw( ComboBox1.Canvas, Rect.Left, Rect.Top, Index );
   // Пишем текст после иконки
   ComboBox1.Canvas.TextOut( Rect.Left + ImageList1.Width + 2, Rect.Top,
   ComboBox1.Items[Index] );
end;


Как осуществить удаление границы вокруг TComboBox'а?

procedure TForm1.FormCreate(Sender: TObject);
begin
   SetWindowRgn( ComboBox1.Handle,
                 CreateRectRgn( 2, 2, ComboBox1.Width-2,
                 ComboBox1.Height-2 ), true );
end;


Как отменить реакию TComboBox на F4?

procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if Key = VK_F4 then Key := 0;
end;


Как использовать разные цвета для каждого элемента TComboBox?

// ComboBox.Style = csOwnerDrawFixed или csOwnerDrawVariable

procedure ComboColor( C: TWinControl; I: Integer; R: TRect;
                      EColor, OColor, FColor: TColor );
begin
   with ( C as TCombobox ) do
   begin
      if Odd( I ) then
         Canvas.Brush.Color := OColor
      else
         Canvas.Brush.Color := EColor;
      Canvas.FillRect( R );
      Canvas.Font.Color := FColor;
      Canvas.TextOut( R.Left, R.Top, Items[I] );
   end;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
   ComboColor( Control, Index, Rect, clInfoBk, clWhite, clBlack );
end;


Как изменить ширину выпадающего списка TComboBox?

// Изменить ширину
procedure TForm1.Button1Click(Sender: TObject);
const
  PIXEL_WIDTH = 200;
begin
   ComboBox1.Perform( CB_SETDROPPEDWIDTH, PIXEL_WIDTH, 0 );
   // Или так
   // SendMessage( ComboBox1.Handle, CB_SETDROPPEDWIDTH, PIXEL_WIDTH, 0 );
end;

// Восстановить ширину "по умолчанию"
procedure TForm1.Button2Click(Sender: TObject);
begin
   Combobox1.Perform( CB_SETDROPPEDWIDTH, ComboBox1.Width, 0 );
end;

// Если нужно точно подогнать ширину выпадающего списка под ширину самого
// длинного пункта этого списка, то можно произвести вычисления.
// Процедуру вычисления удобнее вызывать из конструктора формы (если список
// заполняется во время разработки приложения) или из события OnDropDown
// выпадающего списка (при динамическом заполнении).
procedure ComboBox_AutoWidth( const ComboBox: TCombobox );
const
  HORIZONTAL_PADDING = 4;
var
  ItemsFullWidth: Integer;
  ItemWidth: Integer;
  idx: Integer;
begin
   ItemsFullWidth := 0;

   // Получить ширину пунктов в открытом состоянии
   for idx := 0 to ComboBox.Items.Count-1 do
   begin
      ItemWidth := ComboBox.Canvas.TextWidth( ComboBox.Items[idx] );
      Inc( ItemWidth, 2 * HORIZONTAL_PADDING );
      if ItemWidth > ItemsFullWidth then
         ItemsFullWidth := ItemWidth;
   end;

   // Установить ширину, если необходимо
   if ItemsFullWidth > ComboBox.Width then
   begin
      // Проверить ширину, если есть полоса прокрутки
      if ComboBox.DropDownCount < ComboBox.Items.Count then
         ItemsFullWidth := ItemsFullWidth + GetSystemMetrics( SM_CXVSCROLL );

      SendMessage( ComboBox.Handle, CB_SETDROPPEDWIDTH, ItemsFullWidth, 0 );
   end;
end;


Как сдвинуть выпадающий список TComboBox влево?

// Это может потребоваться в случае, когда мы увеличиваем ширину выпадающего списка
// (CB_SETDROPPEDWIDTH), при этом сам список находится справа на форме, и после
// изменения его ширины поле со списком выходит за пределы окна.
// Решение: перехват сообщения WM_CTLCOLORLISTBOX для TComboBox.
type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ComboBoxWndProcOriginal: TWndMethod;
    procedure ComboBoxWndProc( var Message: TMessage );
  public
  end;

{...}

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
   ComboBoxWndProcOriginal := ComboBox1.WindowProc;
   ComboBox1.WindowProc := ComboBoxWndProc;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   ComboBox1.WindowProc := ComboBoxWndProcOriginal;
end;

procedure TForm1.ComboBoxWndProc(var Message: TMessage);
var
  cr, lbr: TRect;
begin
   // Прорисовываем окно списка
   if Message.Msg = WM_CTLCOLORLISTBOX then
   begin
      GetWindowRect( ComboBox1.Handle, cr );

      // Прямоугольный список
      GetWindowRect( Message.LParam, lbr );

      // Перемещаем влево, выравниваем по правому краю
      if cr.Right <> lbr.Right then
         MoveWindow( Message.LParam,
                 lbr.Left - ( lbr.Right - cr.Right ),
                 lbr.Top,
                 lbr.Right - lbr.Left,
                 lbr.Bottom - lbr.Top,
                 True );
   end;
   ComboBoxWndProcOriginal( Message );
end;


Как связать свои данные с элементами TComboBox?

// Способ первый (на примере TGUID)
type
  PlpGUID = ^TGUID;

var
  {...}
  lpGUID: PlpGUID;

implementation

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
  g: TGUID;
begin
   for i := 1 to 5 do
   begin
      New( lpGUID );
      CreateGUID( g );
      lpGUID^ := g;
      ComboBox1.Items.AddObject( 'Строка ' + IntToStr( i ), TObject( lpGUID ) );
   end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
   Caption := GUIDToString( PlpGUID( ComboBox1.Items.Objects[ComboBox1.ItemIndex] )^ );
end;

// Способ второй (на примере Integer)
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
   for i := 1 to 5 do
   begin
      ComboBox1.Items.AddObject( 'Строка ' + IntToStr( i ), Pointer( i ) );
   end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
   Caption := IntToStr( Integer( ComboBox1.Items.Objects[ComboBox1.ItemIndex] ) );
end;

// Способ третий (на примере String)
type
  PlpStr = ^String;

var
  {...}
  lpStr: PlpStr;

implementation

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
   for i := 1 to 5 do
   begin
      New( lpStr );
      lpStr^ := 'Строка ' + IntToStr( i );
      ComboBox1.Items.AddObject( lpStr^, TObject( lpStr ) );
   end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
   Caption := PlpStr( ComboBox1.Items.Objects[ComboBox1.ItemIndex] )^;
end;

// P.S. При очистке списка не забывайте освобождать память, связанную с элементами списка!


Как определить положение курсора в TComboBox?

procedure TForm1.ComboBox1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   Caption := IntToStr( ComboBox1.SelStart );
end;
 

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