windows - ¿Cómo simular el formulario desplegable en Delphi?

shell drop-down-menu

Question

¿Cómo puedo crear una ventana "desplegable" usando Delphi?

Todo más allá de este punto es el esfuerzo de investigación; y de ninguna manera está relacionado con la respuesta.

Esfuerzo de investigación

Hacer un menú desplegable adecuado requiere muchas piezas para trabajar juntas cuidadosamente. Supongo que a la gente no le gusta la pregunta difícil, y preferiría hacer siete preguntas por separado; cada uno aborda una pequeña parte del problema. Todo lo que sigue es mi esfuerzo de investigación para resolver el problema engañosamente simple.

Tenga en cuenta las características definitorias de una ventana desplegable:

• 1. El menú desplegable se extiende fuera de su ventana de "propietario"
• 2. La ventana "propietario" mantiene el foco; el menú desplegable nunca roba el foco
• 3. La ventana desplegable tiene una sombra paralela

Esta es la variación de Delphi de la misma pregunta que hice en WinForms:

• ¿Cómo simular una ventana desplegable en WinForms?

La respuesta en WinForms era usar la ToolStripDropDown class . Es una clase auxiliar que convierte cualquier forma en un menú desplegable.

Hagámoslo en Delphi

Comenzaré por crear un formulario desplegable chillón, que sirva como ejemplo:

A continuación, soltaré un botón, será lo que haga clic para que aparezca el menú desplegable:

Y finalmente conectaré un código inicial para mostrar el formulario donde debe estar en OnClick :

procedure TForm3.Button1MouseDown(Sender: TObject; 
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
    frmPopup: TfrmPopup;
    pt: TPoint;
begin
    frmPopup := TfrmPopup.Create(Self);

    //Show the form just under, and right aligned, to this button
    pt := Self.ClientToScreen(Button1.BoundsRect.BottomRight);
    Dec(pt.X, frmPopup.ClientWidth);

    frmPopup.Show(Self, Self.Handle, pt);
end;

Editar : se cambió a MouseDown en lugar de hacer clic . El clic es incorrecto, ya que el menú desplegable se muestra sin necesidad de hacer clic. Uno de los problemas pendientes es cómo ocultar un menú desplegable si el usuario vuelve a presionar el botón. Pero dejaremos eso para que la persona que responde la pregunta lo resuelva. Todo en esta pregunta es esfuerzo de investigación, no una solución.

Y nos vamos:

Ahora, ¿cómo hacerlo de la manera correcta?

Lo primero que notamos de inmediato es la falta de una sombra paralela. Eso es porque tenemos que aplicar el estilo de ventana CS_DROPSHADOW :

procedure TfrmPopup.CreateParams(var Params: TCreateParams);
const
    CS_DROPSHADOW = $00020000;
begin
    inherited CreateParams({var}Params);

    Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

Eso arregla eso:

Focus Stealing

El siguiente problema es que llamar a .Show en la ventana emergente hace que se robe el foco (la barra de título de la aplicación indica que ha perdido el foco). Sertac viene con la solución a esto.

• cuando la ventana emergente recibe su mensaje WM_Activate que indica que está recibiendo el foco (es decir, Lo(wParam) <> WA_INACTIVE ):
• envíe el formulario primario WM_NCActivate (verdadero, -1) para indicar que debe dibujarse como si todavía tuviera foco

Manejamos el WM_Activate :

protected
   procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;

y la implementación:

procedure TfrmPopup.WMActivate(var Msg: TWMActivate);
begin
    //if we are being activated, then give pretend activation state back to our owner
    if (Msg.Active <> WA_INACTIVE) then
        SendMessage(Self.PopupParent.Handle, WM_NCACTIVATE, WPARAM(True), -1);

    inherited;
end;

Entonces, la ventana del propietario parece que todavía tiene foco (quién sabe si esa es la forma correcta de hacerlo, solo parece que todavía tiene foco):

Enrollar

Afortunadamente, Sertac ya resuelve el problema de cómo cerrar la ventana cada vez que el usuario hace clic:

• cuando la ventana emergente recibe su mensaje WM_Activate que indica que está perdiendo el foco (es decir, Lo(wParam) = WA_INACTIVE ):
• enviamos al propietario una notificación de que estamos enrollando
• Libere el formulario emergente

WM_Activate eso a nuestro controlador WM_Activate existente:

procedure TfrmPopup.WMActivate(var Msg: TWMActivate);
begin
    //if we are being activated, then give pretend activation state back to our owner
    if (Msg.Active <> WA_INACTIVE) then
        SendMessage(Self.PopupParent.Handle, WM_NCACTIVATE, WPARAM(True), -1);

    inherited;

    //If we''re being deactivated, then we need to rollup
    if Msg.Active = WA_INACTIVE then
    begin
        //TODO: Tell our owner that we''ve rolled up

        //Note: The parent should not be using rollup as the time to read the state of all controls in the popup.
        //      Every time something in the popup changes, the drop-down should give that inforamtion to the owner
        Self.Release; //use Release to let WMActivate complete
    end;
end;

Deslizando el menú desplegable

Los controles desplegables usan AnimateWindow para deslizar el desplegable hacia abajo. Desde el propio combo.c Microsoft:

if (!(TEST_EffectPUSIF(PUSIF_COMBOBOXANIMATION))
      || (GetAppCompatFlags2(VER40) & GACF2_ANIMATIONOFF)) {
   NtUserShowWindow(hwndList, SW_SHOWNA);
} 
else 
{
   AnimateWindow(hwndList, CMS_QANIMATION, (fAnimPos ? AW_VER_POSITIVE :
            AW_VER_NEGATIVE) | AW_SLIDE);
}

Después de verificar si se deben usar animaciones, usan AnimateWindow para mostrar la ventana. Podemos usar SystemParametersInfo con SPI_GetComboBoxAnimation :

Determina si el efecto de apertura deslizante para cuadros combinados está habilitado. El parámetro pvParam debe apuntar a una variable BOOL que recibe TRUE para habilitado, o FALSE para deshabilitado.

Dentro de nuestro método recientemente TfrmPopup.Show , podemos verificar si las animaciones del área del cliente están habilitadas, y llamar a AnimateWindow o Show dependiendo de la preferencia del usuario:

procedure TfrmPopup.Show(Owner: TForm; NotificationParentWindow: HWND;
      PopupPosition: TPoint);
var
    pt: TPoint;
    comboBoxAnimation: BOOL;
begin
    FNotificationParentWnd := NotificationParentWindow;

    //We want the dropdown form "owned" by (i.e. not "parented" to) the OwnerWindow
    Self.Parent := nil; //the default anyway; but just to reinforce the idea
    Self.PopupParent := Owner; //Owner means the Win32 concept of owner (i.e. always on top of, cf Parent, which means clipped child of)
    Self.PopupMode := pmExplicit; //explicitely owned by the owner

    //Show the form just under, and right aligned, to this button
    Self.BorderStyle := bsNone;
    Self.Position := poDesigned;
    Self.Left := PopupPosition.X;
    Self.Top := PopupPosition.Y;

    if not Winapi.Windows.SystemParametersInfo(SPI_GETCOMBOBOXANIMATION, 0, @comboBoxAnimation, 0) then
        comboBoxAnimation := False;

    if comboBoxAnimation then
    begin
        //200ms is the shell animation duration
        AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE);
    end
    else
        inherited Show;
end;

Editar : Resulta que SPI_GETCOMBOBOXANIMATION probablemente debería usarse sobre SPI_GETCLIENTAREAANIMATION . Lo que apunta a la profundidad de la dificultad escondida detrás del sutil "Cómo simular un menú desplegable" . Simular un menú desplegable requiere muchas cosas.

El problema es que Delphi se AnimateWindow si tratas de usar ShowWindow o AnimateWindow a sus espaldas:

¿Cómo resolver eso?

También es extraño que Microsoft use:

• ShowWindow(..., SW_SHOWNOACTIVATE) o
• AnimateWindow(...) * (sin AW_ACTIVATE )

para mostrar el cuadro de lista desplegable sin activación. Y aun así espiando un ComboBox con Spy ++ puedo ver a WM_NCACTIVATE volando.

En el pasado, las personas simulaban una ventana deslizante usando llamadas repetidas para cambiar la Height del formulario desplegable de un temporizador. No solo esto es malo; pero también cambia el tamaño de la forma. En lugar de deslizarse hacia abajo, la forma crece; Puede ver que todos los controles cambian su diseño a medida que aparece el menú desplegable. No, el formulario desplegable sigue siendo su tamaño real, pero deslizarse hacia abajo es lo que se busca aquí.

Sé que AnimateWindow y Delphi nunca se han llevado bien. Y la pregunta se ha planteado, mucho, mucho antes de que llegara Stackoverflow. Incluso pregunté sobre esto en 2005 en los grupos de noticias. Pero eso no puede evitar que vuelva a preguntar.

Traté de forzar mi forma para volver a dibujar después de que se anima:

AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE);
Self.Repaint;
Self.Update;
Self.Invalidate;

Pero no funciona; simplemente se sienta allí burlándose de mí:

Ahora se muestra nuevamente cuando quiero un primer plano

Si se despliega un cuadro combinado, y el usuario intenta seleccionar MouseDown en el botón, el control real de ComboBox de Windows no solo muestra el control nuevamente, sino que lo oculta:

El menú desplegable también sabe que actualmente está "desplegado" , lo que es útil para que pueda dibujarse como si estuviera en modo "desplegable" . Lo que necesitamos es una forma de saber que se despliega el menú desplegable, y una forma de saber que el menú desplegable ya no está desplegado. Algún tipo de variable booleana:

private
   FDroppedDown: Boolean;

Y me parece que tenemos que decirle al anfitrión que estamos cerrando ( es decir, perder la activación ). El anfitrión debe ser responsable de destruir la ventana emergente. (el anfitrión no puede ser responsable de destruir la ventana emergente, sino que conduce a una condición de carrera indestructible) . Entonces creo un mensaje que se usa para notificar al propietario que estamos cerrando:

const
   WM_PopupFormCloseUp = WM_APP+89;

Nota : No sé cómo las personas evitan los conflictos constantes de los mensajes (especialmente desde que CM_BASE comienza en $ B000 y CN_BASE comienza en $ BC00).

Sobre la base de la rutina de activación / desactivación de Sertac:

procedure TfrmPopup.WMActivate(var Msg: TWMActivate);
begin
    //if we are being activated, then give pretend activation state back to our owner
    if (Msg.Active <> WA_INACTIVE) then
        SendMessage(Self.PopupParent.Handle, WM_NCACTIVATE, WPARAM(True), -1);

    inherited;

    //If we''re being deactivated, then we need to rollup
    if Msg.Active = WA_INACTIVE then
    begin
        //DONE: Tell our owner that we''ve rolled up
        //Note: We must post the message. If it is Sent, the owner
        //will get the CloseUp notification before the MouseDown that
        //started all this. When the MouseDown comes, they will think
        //they were not dropped down, and drop down a new one.
        PostMessage(FNotificationParentWnd, WM_PopupFormCloseUp, 0, 0);

        Self.Release; //use release to give WM_Activate a chance to return
    end;
end;

Y luego tenemos que cambiar nuestro código MouseDown para comprender que el menú desplegable aún está allí:

procedure TForm3.Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
    frmPopup: TfrmPopup;
    pt: TPoint;
begin
    //If we (were) dropped down, then don''t drop-down again.
    //If they click us, pretend they are trying to close the drop-down rather than open a second copy
    if FDroppedDown then
    begin
        //And since we''re receiving mouse input, we by defintion must have focus.
        //and since the drop-down self-destructs when it loses activation, 
        //it can no longer be dropped down (since it no longer exists)
        Exit;
    end;

    frmPopup := TfrmPopup.Create(Self);

    //Show the form just under, and right aligned, to this button
    pt := Self.ClientToScreen(Edit1.BoundsRect.BottomRight);
    Dec(pt.X, frmPopup.ClientWidth);

    frmPopup.Show(Self, Self.Handle, pt);
    FDroppedDown := True;
end;

Y creo que eso es todo

Además del acertijo de AnimateWindow , es posible que haya podido usar mi esfuerzo de investigación para resolver todos los problemas que pueda pensar a fin de:

Simular un formulario desplegable en Delphi

Por supuesto, todo esto podría ser en vano. Podría resultar que hay una función de VCL:

TComboBoxHelper = class;
public
   class procedure ShowDropDownForm(...);
end;

En ese caso, esa sería la respuesta correcta.

Answer 1

En la parte inferior del procedure TForm3.Button1Click(Sender: TObject); llama a frmPopup.Show; cambiar eso a ShowWindow(frmPopup.Handle, SW_SHOWNOACTIVATE); y después de eso debes llamar a frmPopup.Visible := True; de lo contrario, los componentes en el formulario no se mostrarán

Entonces, el nuevo procedimiento se ve así:

uses
  frmPopupU;

procedure TForm3.Button1Click(Sender: TObject);
var
  frmPopup: TfrmPopup;
  pt: TPoint;
begin
  frmPopup := TfrmPopup.Create(Self);
  frmPopup.BorderStyle := bsNone;

  //We want the dropdown form "owned", but not "parented" to us
  frmPopup.Parent := nil; //the default anyway; but just to reinforce the idea
  frmPopup.PopupParent := Self;

  //Show the form just under, and right aligned, to this button
  frmPopup.Position := poDesigned;
  pt := Self.ClientToScreen(Button1.BoundsRect.BottomRight);
  Dec(pt.X, frmPopup.ClientWidth);
  frmPopup.Left := pt.X;
  frmPopup.Top := pt.Y;

  //  frmPopup.Show;
  ShowWindow(frmPopup.Handle, SW_SHOWNOACTIVATE);
  //Else the components on the form won''t show
  frmPopup.Visible := True;
end;

Pero esto no evitará que aparezca el robo de foco. Para evitarlo, debe anular el evento WM_MOUSEACTIVATE en su formulario emergente

type
  TfrmPopup = class(TForm)
...
    procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
...
  end;

Y la implementación

procedure TfrmPopup.WMMouseActivate(var Message: TWMMouseActivate);
begin
  Message.Result := MA_NOACTIVATE;
end;

He decidido jugar con tu ventana emergente: lo primero que agregué fue un botón de cerrar. Solo un simple TButton que en su evento onCLick llama Cerrar:

procedure TfrmPopup.Button1Click(Sender: TObject);
begin
  Close;
end;

Pero eso solo ocultaba el formulario, para liberarlo agregué un evento OnFormClose :

procedure TfrmPopup.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

Entonces, finalmente, pensé que sería divertido agregar una función de cambio de tamaño

Lo hice anulando el mensaje WM_NCHITTEST :

procedure TfrmPopup.WMNCHitTest(var Message: TWMNCHitTest);
const
  EDGEDETECT = 7; //adjust to suit yourself
var
  deltaRect: TRect; //not really used as a rect, just a convenient structure
begin
  inherited;

  with Message, deltaRect do
  begin
    Left := XPos - BoundsRect.Left;
    Right := BoundsRect.Right - XPos;
    Top := YPos - BoundsRect.Top;
    Bottom := BoundsRect.Bottom - YPos;

    if (Top < EDGEDETECT) and (Left < EDGEDETECT) then
      Result := HTTOPLEFT
    else if (Top < EDGEDETECT) and (Right < EDGEDETECT) then
      Result := HTTOPRIGHT
    else if (Bottom < EDGEDETECT) and (Left < EDGEDETECT) then
      Result := HTBOTTOMLEFT
    else if (Bottom < EDGEDETECT) and (Right < EDGEDETECT) then
      Result := HTBOTTOMRIGHT
    else if (Top < EDGEDETECT) then
      Result := HTTOP
    else if (Left < EDGEDETECT) then
      Result := HTLEFT
    else if (Bottom < EDGEDETECT) then
      Result := HTBOTTOM
    else if (Right < EDGEDETECT) then
      Result := HTRIGHT;
  end;
end;

Así que finalmente terminé con esto:

unit frmPopupU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmPopup = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  public
    procedure CreateParams(var Params: TCreateParams); override;
  end;

implementation

{$R *.dfm}

{ TfrmPopup }

procedure TfrmPopup.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmPopup.CreateParams(var Params: TCreateParams);
const
  CS_DROPSHADOW = $00020000;
begin
  inherited CreateParams({var}Params);
  Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;

procedure TfrmPopup.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmPopup.FormCreate(Sender: TObject);
begin
  DoubleBuffered := true;
  BorderStyle := bsNone;
end;

procedure TfrmPopup.WMMouseActivate(var Message: TWMMouseActivate);
begin
  Message.Result := MA_NOACTIVATE;
end;

procedure TfrmPopup.WMNCHitTest(var Message: TWMNCHitTest);
const
  EDGEDETECT = 7; //adjust to suit yourself
var
  deltaRect: TRect; //not really used as a rect, just a convenient structure
begin
  inherited;

  with Message, deltaRect do
  begin
    Left := XPos - BoundsRect.Left;
    Right := BoundsRect.Right - XPos;
    Top := YPos - BoundsRect.Top;
    Bottom := BoundsRect.Bottom - YPos;

    if (Top < EDGEDETECT) and (Left < EDGEDETECT) then
      Result := HTTOPLEFT
    else if (Top < EDGEDETECT) and (Right < EDGEDETECT) then
      Result := HTTOPRIGHT
    else if (Bottom < EDGEDETECT) and (Left < EDGEDETECT) then
      Result := HTBOTTOMLEFT
    else if (Bottom < EDGEDETECT) and (Right < EDGEDETECT) then
      Result := HTBOTTOMRIGHT
    else if (Top < EDGEDETECT) then
      Result := HTTOP
    else if (Left < EDGEDETECT) then
      Result := HTLEFT
    else if (Bottom < EDGEDETECT) then
      Result := HTBOTTOM
    else if (Right < EDGEDETECT) then
      Result := HTRIGHT;
  end;
end;

end.

Espero que lo puedas usar.

Código completo y funcional

La siguiente unidad se probó solo en Delphi 5 (soporte emulado para PopupParent ). Pero más allá de eso, hace todo lo que necesita un menú desplegable. Sertac resolvió el problema de AnimateWindow .

unit DropDownForm;

{
    A drop-down style form.

    Sample Usage
    =================

        procedure TForm1.SpeedButton1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        var
            pt: TPoint;
        begin
            if FPopup = nil then
                FPopup := TfrmOverdueReportsPopup.Create(Self);
            if FPopup.DroppedDown then //don''t drop-down again if we''re already showing it
                Exit;

            pt := Self.ClientToScreen(SmartSpeedButton1.BoundsRect.BottomRight);
            Dec(pt.X, FPopup.Width);

            FPopup.ShowDropdown(Self, pt);
        end;

    Simply make a form descend from TDropDownForm.

        Change:
            type
                TfrmOverdueReportsPopup = class(TForm)

        to:
            uses
                DropDownForm;

            type
                TfrmOverdueReportsPopup = class(TDropDownForm)
}

interface

uses
    Forms, Messages, Classes, Controls, Windows;

const
    WM_PopupFormCloseUp = WM_USER+89;

type
    TDropDownForm = class(TForm)
    private
        FOnCloseUp: TNotifyEvent;
        FPopupParent: TCustomForm;
        FResizable: Boolean;
        function GetDroppedDown: Boolean;
{$IFNDEF SupportsPopupParent}
        procedure SetPopupParent(const Value: TCustomForm);
{$ENDIF}
    protected
        procedure CreateParams(var Params: TCreateParams); override;
        procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
        procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;

        procedure DoCloseup; virtual;

        procedure WMPopupFormCloseUp(var Msg: TMessage); message WM_PopupFormCloseUp;

{$IFNDEF SupportsPopupParent}
        property PopupParent: TCustomForm read FPopupParent write SetPopupParent;
{$ENDIF}
  public
        constructor Create(AOwner: TComponent); override;

        procedure ShowDropdown(OwnerForm: TCustomForm; PopupPosition: TPoint);
        property DroppedDown: Boolean read GetDroppedDown;
        property Resizable: Boolean read FResizable write FResizable;

        property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
  end;

implementation

uses
    SysUtils;

{ TDropDownForm }

constructor TDropDownForm.Create(AOwner: TComponent);
begin
    inherited;

    Self.BorderStyle := bsNone; //get rid of our border right away, so the creator can measure us accurately
    FResizable := True;
end;

procedure TDropDownForm.CreateParams(var Params: TCreateParams);
const
    SPI_GETDROPSHADOW = $1024;
    CS_DROPSHADOW = $00020000;
var
    dropShadow: BOOL;
begin
    inherited CreateParams({var}Params);

    //It''s no longer documented (because Windows 2000 is no longer supported)
    //but use of CS_DROPSHADOW and SPI_GETDROPSHADOW are only supported on XP (5.1) or newer
    if (Win32MajorVersion > 5) or ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) then
    begin
        //Use of a drop-shadow is controlled by a system preference
        if not Windows.SystemParametersInfo(SPI_GETDROPSHADOW, 0, @dropShadow, 0) then
            dropShadow := False;

        if dropShadow then
            Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
    end;

{$IFNDEF SupportsPopupParent} //Delphi 5 support for "PopupParent" style form ownership
    if FPopupParent <> nil then
        Params.WndParent := FPopupParent.Handle;
{$ENDIF}
end;

procedure TDropDownForm.DoCloseup;
begin
    if Assigned(FOnCloseUp) then
        FOnCloseUp(Self);
end;

function TDropDownForm.GetDroppedDown: Boolean;
begin
    Result := (Self.Visible);
end;

{$IFNDEF SupportsPopupParent}
procedure TDropDownForm.SetPopupParent(const Value: TCustomForm);
begin
    FPopupParent := Value;
end;
{$ENDIF}

procedure TDropDownForm.ShowDropdown(OwnerForm: TCustomForm; PopupPosition: TPoint);
var
    comboBoxAnimation: BOOL;
    i: Integer;

const
    AnimationDuration = 200; //200 ms
begin
    //We want the dropdown form "owned" by (i.e. not "parented" to) the OwnerForm
    Self.Parent := nil; //the default anyway; but just to reinforce the idea
    Self.PopupParent := OwnerForm; //Owner means the Win32 concept of owner (i.e. always on top of, cf Parent, which means clipped child of)
{$IFDEF SupportsPopupParent}
    Self.PopupMode := pmExplicit; //explicitely owned by the owner
{$ENDIF}

    //Show the form just under, and right aligned, to this button
//  Self.BorderStyle := bsNone; moved to during FormCreate; so can creator can know our width for measurements
    Self.Position := poDesigned;
    Self.Left := PopupPosition.X;
    Self.Top := PopupPosition.Y;

    //Use of drop-down animation is controlled by preference
    if not Windows.SystemParametersInfo(SPI_GETCOMBOBOXANIMATION, 0, @comboBoxAnimation, 0) then
        comboBoxAnimation := False;

    if comboBoxAnimation then
    begin
        //Delphi doesn''t react well to having a form show behind its back (e.g. ShowWindow, AnimateWindow).
        //Force Delphi to create all the WinControls so that they will exist when the form is shown.
        for i := 0 to ControlCount - 1 do
        begin
            if Controls[i] is TWinControl and Controls[i].Visible and
                    not TWinControl(Controls[i]).HandleAllocated then
            begin
                TWinControl(Controls[i]).HandleNeeded;
                SetWindowPos(TWinControl(Controls[i]).Handle, 0, 0, 0, 0, 0,
                        SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
            end;
        end;
        AnimateWindow(Self.Handle, AnimationDuration, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE);
        Visible := True; // synch VCL
    end
    else
        inherited Show;
end;

procedure TDropDownForm.WMActivate(var Msg: TWMActivate);
begin
    //If we are being activated, then give pretend activation state back to our owner
    if (Msg.Active <> WA_INACTIVE) then
        SendMessage(Self.PopupParent.Handle, WM_NCACTIVATE, WPARAM(True), -1);

    inherited;

    //If we''re being deactivated, then we need to rollup
    if Msg.Active = WA_INACTIVE then
    begin
        {
            Post a message (not Send a message) to oursleves that we''re closing up.
            This gives a chance for the mouse/keyboard event that triggered the closeup
            to believe the drop-down is still dropped down.
            This is intentional, so that the person dropping it down knows not to drop it down again.
            They want clicking the button while is was dropped to hide it.
            But in order to hide it, it must still be dropped down.
        }
        PostMessage(Self.Handle, WM_PopupFormCloseUp, WPARAM(Self), LPARAM(0));
    end;
end;

procedure TDropDownForm.WMNCHitTest(var Message: TWMNCHitTest);
var
    deltaRect: TRect; //not really used as a rect, just a convenient structure
    cx, cy: Integer;
begin
    inherited;

    if not Self.Resizable then
        Exit;

    //The sizable border is a preference
    cx := GetSystemMetrics(SM_CXSIZEFRAME);
    cy := GetSystemMetrics(SM_CYSIZEFRAME);

    with Message, deltaRect do
    begin
        Left := XPos - BoundsRect.Left;
        Right := BoundsRect.Right - XPos;
        Top := YPos - BoundsRect.Top;
        Bottom := BoundsRect.Bottom - YPos;

        if (Top < cy) and (Left < cx) then
            Result := HTTOPLEFT
        else if (Top < cy) and (Right < cx) then
            Result := HTTOPRIGHT
        else if (Bottom < cy) and (Left < cx) then
            Result := HTBOTTOMLEFT
        else if (Bottom < cy) and (Right < cx) then
            Result := HTBOTTOMRIGHT
        else if (Top < cy) then
            Result := HTTOP
        else if (Left < cx) then
            Result := HTLEFT
        else if (Bottom < cy) then
            Result := HTBOTTOM
        else if (Right < cx) then
            Result := HTRIGHT;
    end;
end;

procedure TDropDownForm.WMPopupFormCloseUp(var Msg: TMessage);
begin
    //This message gets posted to us.
    //Now it''s time to actually closeup.
    Self.Hide;

    DoCloseup; //raise the OnCloseup event *after* we''re actually hidden
end;

end.

Answer 2

¿Cómo puedo crear una ventana "desplegable" usando Delphi?

Si reúne todos los elementos que ha resumido, no hay una clase / función VCL que produzca una forma desplegable.

Sin embargo, hay algunos puntos para mencionar en su investigación.

Primero, confundes activación con enfoque. El foco no se preserva en el formulario de llamada cuando aparece otra ventana frente a él, la activación es - o parece ser así. El foco es hacia donde va la entrada del teclado, obviamente está en la ventana reventada / caída o en un control en ella.

Su problema con los controles que no se muestran con AnimateWindow es que, VCL no crea controles nativos subyacentes (SO) de TWinControl s hasta que sea necesario (los controles que no son WinControls no son un problema). En lo que concierne a VCL, normalmente no es necesario crearlos hasta que sean visibles, que es cuando configura Visible de su formulario en verdadero (o llama a Show ), que no puede desde entonces no habrá animación, a menos, por supuesto usted establece visible después de la animación.

Este es también el requisito que falta cuando intenta actualizar su formulario:

AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE);
Self.Repaint;
Self.Update;
Self.Invalidate;

Tenga en cuenta que en la cita anterior de la pregunta, ninguna de las llamadas falla. Pero no hay nada que pintar, la forma ni siquiera es visible .

Cualquier forma de forzar que se creen los controles y hacerlos visibles hará que su animación cobre vida.

...
if comboBoxAnimation then
begin
  for i := 0 to ControlCount - 1 do
    if Controls[i] is TWinControl and Controls[i].Visible and
        not TWinControl(Controls[i]).HandleAllocated then begin
      TWinControl(Controls[i]).HandleNeeded;
      SetWindowPos(TWinControl(Controls[i]).Handle, 0, 0, 0, 0, 0,
          SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or
          SWP_SHOWWINDOW);
    end;
  AnimateWindow(Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE);
  Visible := True; // synch VCL
end
else
  ...

Esto es solo un ejemplo, mostrando que el formulario fuera de la pantalla o cualquier otro método creativo podría funcionar igualmente bien. Aquí, en esta respuesta , logro lo mismo al configurar la altura del formulario animado a ''0'' antes de configurar visible a verdadero (me gusta más el enfoque en esta respuesta ...).

En cuanto a no volver a caer cuando el formulario ya está desplegado, no tiene que publicar un mensaje en el formulario de llamada para eso. De hecho, no hagas eso, requiere cooperación innecesaria del formulario de llamada. Siempre habrá una sola instancia para desplegar, por lo que puede utilizar un global:

  TfrmPopup = class(TForm)
    ...
    procedure FormDestroy(Sender: TObject);
  private
    FNotificationParentWnd: HWND;
    class var
      FDroppedDown: Boolean;
  protected
    ...


procedure TfrmPopup.Show(Owner: TForm; NotificationParentWindow: HWND;
  ...

  if not FDroppedDown then begin
      if comboBoxAnimation then begin

        // animate as above

        Visible := True; // synch with VCL
        FDroppedDown := True;
      end
      else
        inherited Show;
    end;
end;

procedure TfrmPopup.FormDestroy(Sender: TObject);
begin
  FDroppedDown := False;
end;