How can i create a "drop-down" window using Delphi?
Everything beyond this point is research effort; and is in no way related to the answer.
Making a proper drop-down requires a lot of pieces to carefully work together. I assume people don't like the difficult question, and would rather i asked seven separate questions; each one addressing one tiny piece of the problem. Everything that follows is my research effort into solving the deceptively simple problem.
Note the defining characteristics of a drop-down window:
This is the Delphi variation of the same question i asked about in WinForms:
The answer in WinForms was to use the ToolStripDropDown class
. It is a helper class that turns any form into a drop-down.
I will start by creating a gaudy dropdown form, that serves as the example:
Next i will drop a button, that will be the thing i click to make the drop-down appear:
And finally i will wire-up some initial code to show the form where it needs to be in the 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;
Edit: Changed it to MouseDown rather than Click. Click is incorrect, as the drop-down is shown without the need to click. One of the unresolved issues is how to hide a drop-down if the user mouse-downs the button again. But we'll leave that for the person who answers the question to solve. Everything in this question is research effort - not a solution.
And we're off:
First thing we notice right away is the lack of a drop-shadow. That's because we need to apply the CS_DROPSHADOW
window style:
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;
That fixes that:
The next issue is that calling .Show
on the popup causes it to steal focus (the title bar of the application indicates that it has lost focus). Sertac comes up with the solution to this.
WM_Activate
message indicating that it is receiving focus (i.e. Lo(wParam) <> WA_INACTIVE
):WM_NCActivate
(True, -1) to indicate that it should draw itself like it still has focus We handle the WM_Activate
:
protected procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
and the implementation:
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;
So the owner window looks like it still has focus (who knows if that is the correct way to do it - it only looks like it still has focus):
Fortunately, Sertac already solves the problem of how to dismiss the window whenever the user clicks away:
WM_Activate
message indicating that it is losing focus (i.e. Lo(wParam) = WA_INACTIVE
):We add that to our existing WM_Activate
handler:
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;
Dropdown controls use AnimateWindow
to slide the drop-down down. From Microsoft's own combo.c
:
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); }
After checking if animations should be used, they use AnimateWindow
to show the window. We can use SystemParametersInfo
with SPI_GetComboBoxAnimation:
Determines whether the slide-open effect for combo boxes is enabled. The pvParam parameter must point to a BOOL variable that receives TRUE for enabled, or FALSE for disabled.
Inside our newly consecrated TfrmPopup.Show
method, we can check if client area animations are enabled, and call either AnimateWindow
or Show
depending on the user's preference:
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;
Edit: Turns out there is SPI_GETCOMBOBOXANIMATION
which should probably use over SPI_GETCLIENTAREAANIMATION
. Which points to the depths of difficulty hidden behind the subtle "How to simulate a drop-down". Simulating a drop-down requires a lot of stuff.
The problem is that Delphi forms pretty much fall over dead if you try to use ShowWindow
or AnimateWindow
behind their back:
How to solve that?
It's also odd that Microsoft itself uses either:
ShowWindow(..., SW_SHOWNOACTIVATE)
, orAnimateWindow(...)
*(without AW_ACTIVATE
) to show the drop-down listbox without activation. And yet spying on a ComboBox with Spy++ i can see WM_NCACTIVATE
flying around.
In the past people have simulated a slide window using repeated calls to change the Height
of the drop-down form from a timer. Not only is this bad; but it also changes the size of the form. Rather than sliding down, the form grows down; you can see all the controls change their layout as the drop-down appears. No, having the drop-down form remain it's real size, but slide down is what is wanted here.
I know AnimateWindow
and Delphi have never gotten along. And the question has been asked, a lot, long before Stackoverflow arrived. I even asked about it in 2005 on the newsgroups. But that can't stop me from asking again.
I tried to force my form to redraw after it animates:
AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE); Self.Repaint; Self.Update; Self.Invalidate;
But it doesn't work; it just sits there mocking me:
If a combobox is dropped down, and the user tries to MouseDown on the button, the real Windows ComboBox control does not simply show the control again, but instead hides it:
The drop-down also knows that it is currently "dropped-down", which is useful so that it can draw itself as if it is in "dropped down" mode. What we need is a way to know that the drop-down is dropped down, and a way to know that the drop-down is no longer dropped down. Some kind of boolean variable:
private FDroppedDown: Boolean;
And it seems to me that we need to tell the host that we're closing up (i.e. losing activation). The host then needs to be responsible for destroying the popup. (the host cannot be responsible for destroying the popup; it leads to an unresolvable race condition). So i create a message used to notify the owner that we're closing up:
const WM_PopupFormCloseUp = WM_APP+89;
Note: I don't know how people avoid message constant conflicts (especially since CM_BASE
starts at $B000 and CN_BASE
starts at $BC00).
Building on Sertac's activation/deactivation routine:
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;
And then we have to change our MouseDown code to understand that the drop-down is still there:
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;
Aside from the AnimateWindow
conundrum, i may have been able use my research effort to solve all the problems i can think of in order to:
Simulate a drop-down form in Delphi
Of course, this could all be for naught. It might turn out there's a VCL function:
TComboBoxHelper = class; public class procedure ShowDropDownForm(...); end;
In which case that would be the correct answer.
At the bottom of procedure TForm3.Button1Click(Sender: TObject);
you call frmPopup.Show;
change that to ShowWindow(frmPopup.Handle, SW_SHOWNOACTIVATE);
and after that you need to call frmPopup.Visible := True;
else the components on the form won't show
So the new procedure looks like this:
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;
But this won't prevent you popup from stealing focus. Inorder for preventing that, you need to override the WM_MOUSEACTIVATE
event in your popup form
type TfrmPopup = class(TForm) ... procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; ... end;
And the implementation
procedure TfrmPopup.WMMouseActivate(var Message: TWMMouseActivate); begin Message.Result := MA_NOACTIVATE; end;
I've decided to play arround with your popup window: The first thing I added was a close button. Just a simple TButton which in its onCLick Event calls Close:
procedure TfrmPopup.Button1Click(Sender: TObject); begin Close; end;
But that would only hide the form, in order for freeing it I added a OnFormClose
event:
procedure TfrmPopup.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end;
Then finally I thought it would be funny to add a resize function
I did that by overriding the WM_NCHITTEST
Message :
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;
So finally I've ended up with this :
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.
Hope you can use it.
The following unit was tested only in Delphi 5 (emulated support for PopupParent
). But beyond that, it does everything a drop-down needs. Sertac solved the AnimateWindow
problem.
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.
How can i create a "drop-down" window using Delphi?
You put together all the bits and pieces you have summarized, there is no one VCL class/function that would produce a drop down form.
There are a few points to mention in your research though.
First, you're confusing activation with focus. Focus is not preserved in the calling form when another window pops in front of it, activation is - or it seems that way. Focus is where keyboard input goes, it is obviously on either the popped/dropped window or on a control in it.
Your problem with controls not showing with AnimateWindow
is that, VCL does not create underlying native (OS) controls of TWinControl
s until it is necessary (non-wincontrols are not a problem). As far as VCL is concerned, creating them is not normally necessary until they will be visible, which is when you set Visible
of your form to true (or call Show
), which you cannot since then there will be no animation, unless of course you set visible
after the animation.
This is also the missing requirement when you try to refresh your form:
AnimateWindow(Self.Handle, 200, AW_VER_POSITIVE or AW_SLIDE or AW_ACTIVATE); Self.Repaint; Self.Update; Self.Invalidate;
Notice that in the above quote from the question, none of the calls fail. But there's nothing to paint, the form is not even visible
yet.
Any means of forcing the controls to be created and making them visible will make your animation come alive.
... 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 ...
This is just an example, showing the form off-screen or any other creative method could work equally well. Here, in this answer, I achieve the same by setting animated form's height to '0' before setting visible
to true (I like the approach in this answer better though..).
Regarding not dropping again when the form is already dropped down, you don't have to post a message to the calling form for that. In fact don't do that, it requires unnecessary cooperation from the calling form. There will ever be only one instance to be dropped down, so you can use a 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;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With