showmodal - devexpress windows forms demo




どのようにデルファイのドロップダウンフォームをシミュレートするには? (2)

procedure TForm3.Button1Click(Sender: TObject);の下部にprocedure TForm3.Button1Click(Sender: TObject); あなたはfrmPopup.Show;を呼び出しfrmPopup.Show; それをShowWindow(frmPopup.Handle, SW_SHOWNOACTIVATE);変更しShowWindow(frmPopup.Handle, SW_SHOWNOACTIVATE); その後、 frmPopup.Visible := True;を呼び出す必要がありfrmPopup.Visible := True; そうでなければ、フォーム上のコンポーネントは表示されません

したがって、新しい手順は次のようになります。

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;

しかし、これによってポップアップがフォーカスを奪うのを妨げることはありません。 それを防ぐために、ポップアップフォームでWM_MOUSEACTIVATEイベントをオーバーライドする必要があります

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

そして、実装

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

私はあなたのポップアップウィンドウでarroundをプレイすることに決めました:最初に追加したのはクローズボタンでした。 onclickイベントでCloseを呼び出す単純なTButtonです:

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

しかし、それはフォームを非表示にするだけで、フォームを解放するためにOnFormCloseイベントを追加しました:

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

最後に、サイズ変更関数を追加するのは面白いと思った

私はWM_NCHITTESTメッセージをオーバーライドすることでそれを行い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;

だから最後に私はこれで終わりました:

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.

あなたはそれを使用することを願っています。

完全な機能コード

次のユニットは、Delphi 5( PopupParentエミュレートサポート)でのみテストされました。 しかし、それを超えて、それはすべてのドロップダウンのニーズがあります。 SertacはAnimateWindow問題を解決し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.

Delphiを使用「ドロップダウン」ウィンドウを作成するにはどうすればよいですか?

この点を越えるものはすべて研究努力です。 決して答えには関係しません。

研究努力

適切なドロップダウンを行うには、慎重に一緒に作業するために多くの断片が必要です。 私は人々が難しい質問が好きではないと思い、むしろ私は7つの別々の質問をしました。 それぞれが問題の1つの小さな問題に対処しています。 次のすべてが、私は思慮深く単純な問題を解決するための研究努力です。

ドロップダウンウィンドウの定義上の特徴に注意してください。

  • 1.ドロップダウンが「所有者」ウィンドウの外に広がります
  • 2. 「所有者」ウィンドウはフォーカスを保持します。 ドロップダウンは決して焦点を盗むことはありません
  • 3.ドロップダウンウィンドウにドロップシャドウが表示されます

これは私がWinFormsで尋ねたのと同じ質問のDelphiのバリエーションです:

WinFormsの答えは、 ToolStripDropDown classを使用することでした。 フォームをドロップダウンに変換するヘルパークラスです。

Delphiでやってみましょう

私は、例として役立つ堂々たるドロップダウンフォームを作成することから始めます:

次に、ボタンをドロップします。これは、ドロップダウンを表示するためにクリックするものです。

そして最後に、 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;

編集 :それをクリックするのではなくマウスダウンに変更しました 。 クリックする必要はなく、ドロップダウンが表示されるため、クリックが正しくありません。 解決されていない問題の1つは、ユーザーがボタンをもう一度マウスでクリックした場合にドロップダウンを非表示にする方法です。 しかし、私たちは解決するために質問に答える人のためにそれを残します。 この質問のすべては、研究努力であり解決策ではありません。

そして、私たちは去っています:

今それを正しい方法で行う方法は?

すぐに最初に気づくのは、ドロップシャドウがないことです。 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;

それはそれを修正する:

フォーカススチール

次の問題は、ポップアップで.Showを呼び出すとフォーカスを奪ってしまうことです(アプリケーションのタイトルバーはフォーカスを失ったことを示します)。 Sertacはこれに対する解決策を思いつきます。

  • ポップアップがフォーカスを受け取っていることを示すWM_Activateメッセージを受信すると(つまりLo(wParam) <> WA_INACTIVE
  • 親フォームにWM_NCActivate (True、-1)を送信して、まだフォーカスがあるように描画する必要があることを示します。

WM_Activateを処理しWM_Activate

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

実装:

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;

したがって、オーナーウィンドウにはまだフォーカスがあるように見えます(これが正しい方法であるかどうかは分かりますが、フォーカスがあるように見えます)。

ロールアップ

幸いにも、Sertacは既に、ユーザーがクリックするたびにウィンドウを消す方法の問題を解決しています:

  • ポップアップがフォーカスを失っていることを示すWM_Activateメッセージを受信すると(つまりLo(wParam) = WA_INACTIVE
  • 所有者が私たちが巻き起こっているという通知を送る
  • ポップアップフォームを解放する

これを既存のWM_Activateハンドラに追加します。

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;

ドロップダウンをスライドさせる

ドロップダウンコントロールは、 AnimateWindowを使用してドロップダウンをスライドさせます。 Microsoft独自の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);
}

アニメーションを使用するかどうかを確認した後、 AnimateWindowを使用してウィンドウを表示します。 SPI_GetComboBoxAnimationSystemParametersInfoを使うことができます:

コンボボックスのスライドオープンエフェクトを有効にするかどうかを指定します。 pvParamパラメータは、有効にするにはTRUE 、無効にするにはFALSEを受け取るBOOL変数を指す必要があります。

TfrmPopup.Showメソッドでは、 クライアント領域のアニメーションが有効になっているかどうかを確認し、 AnimateWindowまたはShowを呼び出すことができます。

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;

編集 :おそらくSPI_GETCOMBOBOXANIMATIONで使用するSPI_GETCLIENTAREAANIMATIONます。 微妙な"ドロップダウンをシミュレートする方法"の後ろに隠されている難しさの深さを指しています。 ドロップダウンをシミュレートするには多くのものが必要です。

問題は、 ShowWindowまたはAnimateWindowを背中にして使用しようとすると、Delphiがかなり倒れてしまうことです。

それを解決するには?

マイクロソフト自身が次のいずれかを使用することも奇妙です。

  • ShowWindow(..., SW_SHOWNOACTIVATE) 、または
  • AnimateWindow(...) *( AW_ACTIVATEなし)

アクティブ化せずにドロップダウンリストボックスを表示します。 Spy ++でComboBoxをスパイすると、 WM_NCACTIVATE飛んでいくのがわかります。

過去の人々は、タイマーからドロップダウンフォームのHeightを変更するために繰り返し呼び出しを使用してスライドウィンドウをシミュレートしました。 これは悪いだけでなく、 フォームのサイズも変更されます。 下に滑り落ちるのではなく、形が崩れます。 ドロップダウンが表示されるので、すべてのコントロールがレイアウトを変更することがわかります。 いいえ、ドロップダウン形式を残しているのは実際のサイズですが、スライドダウンはここで欲しいものです。

私はAnimateWindowとDelphiが一度AnimateWindowていないことを知っています。 そして、Stackoverflowが到着するずっと前から、たくさんの質問がありました。 私は2005年にニュースグループでそれについて尋ねました。 しかし、それは私が再び尋ねるのを止めることはできません。

アニメーションを作成した後、フォームを強制的に再描画するようにしました。

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

しかし、それは動作しません。 それはちょうどそこに座って私を嘲笑します:

私がクローズアップしたいときに再び表示する

コンボボックスがドロップされ、ユーザーがボタンのMouseDownを試行した場合、実際のWindowsコンボボックスコントロールは単にコントロールを再度表示するのではなく、

ドロップダウンは、現在ドロップダウンされていることも知っています。これは、 ドロップされたかのように自分自身を引き出すのに便利です。 私たちに必要なのは、ドロップダウンがドロップダウンされたことを知る方法と、ドロップダウンがもはやドロップされていないことを知る方法です。 ブール変数のいくつかの種類:

private
   FDroppedDown: Boolean;

そして私には、私たちが閉鎖しようとしている( つまり活性化が失われている)ことをホストに伝える必要があるようです。 ホストはポップアップを破壊する責任を負う必要があります。 (ホストはポップアップを破壊する責任を負うことはできず、解決できない競合状態につながります) 。 だから私は私たちがクローズアップしていることを所有者に通知するために使用されるメッセージを作成する:

const
   WM_PopupFormCloseUp = WM_APP+89;

:私は人々がメッセージ定数の競合を避ける方法を知りません(特に、 CM_BASEは$ B000から開始し、 CN_BASEは$ BC00から開始するため)。

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;

ドロップダウンがまだあることを理解するために、 MouseDownコードを変更する必要があります。

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;

そして私はそれがだと思います

AnimateWindow謎を別にすれば、私は考えることができるすべての問題を解決するために私の研究努力を利用できるかもしれません:

Delphiでドロップダウンフォームをシミュレートする

もちろん、これはまったく無神経なものかもしれません。 VCL関数があるかもしれません:

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

どの場合には正しい答えになるでしょう。


Delphiを使用して「ドロップダウン」ウィンドウを作成するにはどうすればよいですか?

要約したすべてのビットとピースをまとめると、ドロップダウンフォームを生成するVCLクラス/関数はありません。

あなたの研究で言及するいくつかのポイントがあります。


まず、アクティブ化をフォーカスと混同しています。 フォーカスは、別のウィンドウがポップアップしたときに、呼び出し元のフォームに保持されません。アクティブ化されている - そうかもしれません。 フォーカスは、キーボード入力が行われる場所です。ポップされたウィンドウまたはドロップされたウィンドウ、またはコントロール内のコントロールに表示されます。


AnimateWindowで表示されないコントロールの問題は、VCLはTWinControlの基本的なネイティブ(OS)コントロールを必要になるまで(非wincontrolは問題にならない)作成しないということです。 VCLに関しては、フォームをVisibleに設定する(またはShow呼び出す)ことは不可能ですが、それ以降はアニメーションは表示されない限り通常は必要ありませんアニメーションの後にvisibleに設定しvisible

フォームをリフレッシュしようとすると、次のような欠点もあります。

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

上記の質問の引用では、いずれの呼び出しも失敗しないことに注意してください。 しかし、ペイントするものは何もなく、フォームはまだvisibleません。

コントロールを強制的に作成して見えるようにする手段は、アニメーションを生き生きとさせるでしょう。

...
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
  ...

これは単なる例であり、画面外の形式やその他の創造的な方法も同様に機能します。 ここでは、この答えで 、アニメーションフォームの高さを '0'に設定してから、trueに設定しています(私はこの回答のアプローチがより好きですが..)。


フォームがすでにドロップダウンされているときに再びドロップしないことについては、そのフォームを呼び出しフォームにメッセージを投稿する必要はありません。 実際にはそれをしないでください、それは呼び出しフォームからの不必要な協力を必要とします。 ドロップダウンするインスタンスが1つしかないので、グローバルなインスタンスを使用できます。

  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;






delphi-xe6