unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TComboBox = class(Vcl.StdCtrls.TComboBox)
  private
    FMouseInList: Boolean;
    FListBoxHandle: HWND;
    FListBoxWndProc: Pointer;
    FListBoxInstance: Pointer;
    FOnDropListLeave: TNotifyEvent;
    procedure WMParentNotify(var AMessage: TMessage); message WM_PARENTNOTIFY;
  protected
    procedure ListBoxWndProc(var AMessage: TMessage); virtual;
  public
    destructor Destroy; override;
    property OnDropListLeave: TNotifyEvent read FOnDropListLeave write FOnDropListLeave;
  end;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1MouseEnter(Sender: TObject);
  private
    procedure DropListLeave(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TComboBox }

destructor TComboBox.Destroy;
begin
  if (FListHandle <> 0) and Assigned(FListBoxInstance) then
  begin
    SetWindowLong(FListHandle, GWL_WNDPROC, IntPtr(FListBoxWndProc));
    FreeObjectInstance(FListBoxInstance);
    FListBoxInstance := nil;
  end;
  inherited;
end;

procedure TComboBox.WMParentNotify(var AMessage: TMessage);
begin
  if (FListBoxHandle = 0) and (AMessage.WParamLo = WM_CREATE) then
  begin
    FMouseInList := False;
    FListBoxHandle := AMessage.LParam;
    FListBoxWndProc := Pointer(GetWindowLong(FListBoxHandle, GWL_WNDPROC));
    FListBoxInstance := MakeObjectInstance(ListBoxWndProc);
    SetWindowLong(FListBoxHandle, GWL_WNDPROC, IntPtr(FListBoxInstance));
  end
  else
    inherited;
end;

procedure TComboBox.ListBoxWndProc(var AMessage: TMessage);
var
  R: TRect;
  P: TPoint;
  InRect: Boolean;
begin
  if (FListBoxHandle <> 0) and (AMessage.Msg = WM_MOUSEMOVE) then
  begin
    if Winapi.Windows.GetClientRect(FListBoxHandle, R) then
    begin
      P.X := TWMMouseMove(AMessage).XPos;
      P.Y := TWMMouseMove(AMessage).YPos;
      InRect := PtInRect(R, P);

      if InRect xor FMouseInList then
      begin
        FMouseInList := InRect;
        if not InRect and Assigned(FOnDropListLeave) then
          FOnDropListLeave(Self);
      end;
    end;
  end;

  AMessage.Result := CallWindowProc(FListBoxWndProc,
    FListBoxHandle, AMessage.Msg, AMessage.WParam, AMessage.LParam);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.OnDropListLeave := DropListLeave;
end;

procedure TForm1.ComboBox1MouseEnter(Sender: TObject);
begin
  ComboBox1.DroppedDown := True;
end;

procedure TForm1.DropListLeave(Sender: TObject);
begin
  ComboBox1.DroppedDown := False;
end;

end.