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:
- 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.
- The code above was tested with D5/XP.
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…