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;