Can I programmatically set the position of ComboBox dropdown list?

前端 未结 2 1922
故里飘歌
故里飘歌 2020-12-21 00:41

Ordinary Windows ComboBox (csDropDown or csDropDownList style) will open its dropdown list right below or, if no space left below, above the combo.

相关标签:
2条回答
  • 2020-12-21 01:18

    Well, you can do this by using GetComboBoxInfo to obtain a handle to the window used for the list, and then move that window. Like this:

    type
      TMyForm = class(TForm)
        ComboBox1: TComboBox;
        procedure ComboBox1DropDown(Sender: TObject);
      protected
        procedure WMMoveListWindow(var Message: TMessage); message WM_MOVELISTWINDOW;
      end;
    
    ....
    
    procedure TMyForm.ComboBox1DropDown(Sender: TObject);
    begin
      PostMessage(Handle, WM_MOVELISTWINDOW, 0, 0);
    end;
    
    procedure TMyForm.WMMoveListWindow(var Message: TMessage);
    var
      cbi: TComboBoxInfo;
      Rect: TRect;
      NewTop: Integer;
    begin
      cbi.cbSize := SizeOf(cbi);
      GetComboBoxInfo(ComboBox1.Handle, cbi);
      GetWindowRect(cbi.hwndList, Rect);
      NewTop := ClientToScreen(Point(0, ComboBox1.Top-Rect.Height)).Y;
      MoveWindow(cbi.hwndList, Rect.Left, NewTop, Rect.Width, Rect.Height, True);
    end;
    

    I have ignored the issue of error checking to keep the code simple.

    However, be warned that it looks pretty horrible because the dropdown animation is still shown. Perhaps you can find a way to disable that.

    However, you simply do not need to do anything like this because Windows already does it for you. Drag a form to the bottom of the screen and drop down your combo. Then you will see the list appear above the combo. Like this:

    enter image description here

    0 讨论(0)
  • 2020-12-21 01:30

    Posting a code example that will show drop-down list animation correctly and will force showing the drop-down list above ComboBox1. this code subclasses ComboBox hwndList:

    TForm1 = class(TForm)
      ComboBox1: TComboBox;
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
    private
      FComboBoxListDropDown: Boolean;
      FComboBoxListWnd: HWND;
      FOldComboBoxListWndProc, FNewComboBoxListWndProc: Pointer;
      procedure ComboBoxListWndProc(var Message: TMessage);
    end;
    
    ....
    
    procedure TForm1.FormCreate(Sender: TObject);
    var
      Info: TComboBoxInfo;
    begin
      ZeroMemory(@Info, SizeOf(Info));
      Info.cbSize := SizeOf(Info);
      GetComboBoxInfo(ComboBox1.Handle, Info);
      FComboBoxListWnd := Info.hwndList;
      FNewComboBoxListWndProc := MakeObjectInstance(ComboBoxListWndProc);
      FOldComboBoxListWndProc := Pointer(GetWindowLong(FComboBoxListWnd, GWL_WNDPROC));
      SetWindowLong(FComboBoxListWnd, GWL_WNDPROC, Integer(FNewComboBoxListWndProc));
    end;
    
    procedure TForm1.FormDestroy(Sender: TObject);
    begin
      SetWindowLong(FComboBoxListWnd, GWL_WNDPROC, Integer(FOldComboBoxListWndProc));
      FreeObjectInstance(FNewComboBoxListWndProc);
    end;
    
    procedure TForm1.ComboBoxListWndProc(var Message: TMessage);
    var
      R: TRect;
      DY: Integer;
    begin
      if (Message.Msg = WM_MOVE) and not FComboBoxListDropDown then
      begin
        FComboBoxListDropDown := True;
        try
          GetWindowRect(FComboBoxListWnd, R);
          DY := (R.Bottom - R.Top) + ComboBox1.Height + 1;
          // set new Y position for drop-down list: always above ComboBox1
          SetWindowPos(FComboBoxListWnd, 0, R.Left, R.Top - DY , 0, 0,
            SWP_NOOWNERZORDER or SWP_NOZORDER or SWP_NOSIZE  or SWP_NOSENDCHANGING);
        finally
          FComboBoxListDropDown := False;
        end;
      end;
      Message.Result := CallWindowProc(FOldComboBoxListWndProc,
        FComboBoxListWnd, Message.Msg, Message.WParam, Message.LParam);
    end;
    

    Notes:

    1. I totally agree with David, and others that this is a bad idea to change this specific default behavior for TComboBox. OP did not yet respond to why he wanted such behavior.
    2. The code above was tested with D5/XP.
    0 讨论(0)
提交回复
热议问题