親コントロールのサイズが変更された瞬間を捕まえるには？

Question

私はTWinControlから派生したビジュアルコンポーネントを持っています。親コントロールがサイズ変更されたときにコンポーネントで作業を行う必要があります。一般的なケースでは、私のコンポーネントの "Align"プロパティはalNoneです。

親コントロールのサイズ変更のイベントをキャッチするにはどうすればよいですか？出来ますか？ここで

Answer 1

TWinControl（親）のサイズが変更された場合、ハンドラでTWinControl.Realignが呼び出されます。これは、TWinControl.AlignControlsを介して、他に何かに設定されたAlignプロパティを持つすべての子コントロールに対して反復処理を行います。alNone。 alCustomに設定すると、子コントロールのSetBoundsは、アンカーの関与のためにサイズが変更されている場合でも、変更されていない引数で呼び出されます。

ので、alCustomに揃えを設定し、親のサイズ変更の通知を持っている：

TChild = class(T...Control) 
    private 
    FInternalAlign: Boolean; 
    function GetAlign: TAlign; 
    procedure ParentResized; 
    procedure SetAlign(Value: TAlign); 
    protected 
    procedure RequestAlign; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 
    published 
    property Align: TAlign read GetAlign write SetAlign default alCustom; 
    end; 

constructor TChild.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    Align := alCustom; 
end; 

function TChild.GetAlign: TAlign; 
begin 
    Result := inherited Align; 
end; 

procedure TChild.ParentResized; 
begin 
end; 

procedure TChild.RequestAlign; 
begin 
    FInternalAlign := True; 
    try 
    inherited RequestAlign; 
    finally 
    FInternalAlign := False; 
    end; 
end; 

procedure TChild.SetAlign(Value: TAlign); 
begin 
    if Value = alNone then 
    Value := alCustom; 
    inherited Align := Value; 
end; 

procedure TChild.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 
begin 
    if not FInternalAlign then 
    if (Align <> alCustom) or ((ALeft = Left) and (ATop = Top) and 
     (AWidth = Width) and (AHeight = Height)) then 
     ParentResized; 
    inherited SetBounds(ALeft, ATop, AWidth, AHeight); 
end; 

私は今のところ考えることができる唯一の欠点は、AlignプロパティはalNoneなることはありませんということです、その可能性コンポーネントのユーザーを混乱させる。内部継承プロパティがalCustomに設定されている場合は、alNoneを表示または返すことは簡単に可能ですが、それはアドバイスではなく、もっと混乱させます。このコンポーネントの機能として、alCustomの設定を考慮してください。

注：この構成では、コンポーネントのユーザーは依然としてカスタムアラインメントを実装できます。

これは私のテストコードです。たぶんあなたは自分でいくつかのテストを追加したいです。

unit Unit1; 

interface 

uses 
    Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; 

type 
    TForm1 = class(TForm) 
    TestButton: TButton; 
    Panel1: TPanel; 
    procedure FormCreate(Sender: TObject); 
    procedure TestButtonClick(Sender: TObject); 
    private 
    FChild: TControl; 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

type 
    TChild = class(TGraphicControl) 
    private 
    FInternalAlign: Boolean; 
    function GetAlign: TAlign; 
    procedure ParentResized; 
    procedure SetAlign(Value: TAlign); 
    protected 
    procedure Paint; override; 
    procedure RequestAlign; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 
    published 
    property Align: TAlign read GetAlign write SetAlign default alCustom; 
    end; 

{ TChild } 

constructor TChild.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    Align := alCustom; 
end; 

function TChild.GetAlign: TAlign; 
begin 
    Result := inherited Align; 
end; 

procedure TChild.Paint; 
begin 
    Canvas.TextRect(ClientRect, 2, 2, 'Parent resize count = ' + IntToStr(Tag)); 
end; 

procedure TChild.ParentResized; 
begin 
    Tag := Tag + 1; 
    Invalidate; 
end; 

procedure TChild.RequestAlign; 
begin 
    FInternalAlign := True; 
    try 
    inherited RequestAlign; 
    finally 
    FInternalAlign := False; 
    end; 
end; 

procedure TChild.SetAlign(Value: TAlign); 
begin 
    if Value = alNone then 
    Value := alCustom; 
    inherited Align := Value; 
end; 

procedure TChild.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 
begin 
    if not FInternalAlign then 
    if (Align <> alCustom) or ((ALeft = Left) and (ATop = Top) and 
     (AWidth = Width) and (AHeight = Height)) then 
     ParentResized; 
    inherited SetBounds(ALeft, ATop, AWidth, AHeight); 
end; 

{ TForm1 } 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    FChild := TChild.Create(Self); 
    FChild.SetBounds(10, 10, 200, 50); 
    FChild.Parent := Self; 
end; 

procedure TForm1.TestButtonClick(Sender: TObject); 
var 
    OldCount: Integer; 
begin 
    OldCount := FChild.Tag; 

    Width := Width + 25;              //1 
    MoveWindow(Handle, Left, Top, Width + 25, Height, True);     //2 
    SetWindowPos(Handle, HWND_TOP, Left, Top, Width + 25, Height, 
    SWP_NOMOVE or SWP_NOSENDCHANGING or SWP_SHOWWINDOW);     //3 

    FChild.Anchors := [akLeft, akTop, akRight]; 
    Width := Width + 25;              //4 
    MoveWindow(Handle, Left, Top, Width + 25, Height, True);     //5 
    SetWindowPos(Handle, HWND_TOP, Left, Top, Width + 25, Height, 
    SWP_NOMOVE or SWP_NOSENDCHANGING or SWP_SHOWWINDOW);     //6 

    FChild.Anchors := [akLeft, akTop]; 
    Panel1.Anchors := [akLeft, akTop, akRight]; 
    FChild.Parent := Panel1;             //7 
    Width := Width + 25;              //8 
    MoveWindow(Handle, Left, Top, Width + 25, Height, True);     //9 
    SetWindowPos(Handle, HWND_TOP, Left, Top, Width + 25, Height, 
    SWP_NOMOVE or SWP_NOSENDCHANGING or SWP_SHOWWINDOW);     //10 

    FChild.Align := alRight; 
    Width := Width + 25;              //11 
    MoveWindow(Handle, Left, Top, Width + 25, Height, True);     //12 
    SetWindowPos(Handle, HWND_TOP, Left, Top, Width + 25, Height, 
    SWP_NOMOVE or SWP_NOSENDCHANGING or SWP_SHOWWINDOW);     //13 

    if FChild.Tag = OldCount + 13 then 
    ShowMessage('Test succeeded') 
    else 
    ShowMessage('Test unsuccessful'); 
end; 

end. 

Answer 2

はあなたを助けるためにexapmleです：

procedure TForm1.Button1Click(Sender: TObject); 
var newMethod: TMethod; 
begin 
    newMethod.Code := MethodAddress('OnResizez'); //your action for parent resize 
    newMethod.Data := Pointer(self); 
    SetMethodProp(button1.Parent, 'OnResize', newMethod); //set event to button1.parent 
end; 

procedure TForm1.OnResizez(Sender: TObject); 
begin 
    button1.Width := button1.Width+1; //action on resize 
end; 

Answer 3

はい、アンドリューは、私が親のメッセージループ（それをサブクラス化）にコンポーネントを取り付けることは移動するための方法だと思います。そのためにはTControl.WindowProcプロパティを使用できます。 docは、あなたがしたい場合は、あなたの交換が

procedure TMyComponent.SubclassedParentWndProc(Var Msg: TMessage); 
begin 
    FOldParentWndProc(Msg); 
    if(Msg.Message = WM_SIZE)then begin 
     ... 
    end; 
end; 

のようになります。つまり、オリジナルを保存し、（コンポーネントのデストラクタで）後でそれを復元しても、元のハンドラにメッセージを渡すためにしなければならないことを説明してそれは "古いshool"方法、GWLP_WNDPROCでSetWindowLongPtr APIを使用しますが、AFAIK WindowProcは、コンポーネントをサブクラス化しやすくするために、正確に導入されました。

Answer 4

警告：完全に書き換えます。おかげでロブ!!

例SetWindowSubClassを使用しています。

Answer 5

私は同様の問題の解決策を探していました。しかし、私の場合は私はアライメントのような制限を持つことができない、とサブクラスは、だから私は、次のアイデアを思い付いた

（アライメントthingieは今、私はそれを見ていることを、あまりにも行き過ぎに見える）やり過ぎに見えた：

type 
    TMyComponent = class(TControl) 
    private 
    FParentLastWidth: integer; 
    ... 
    procedure Invalidate; override; 
    ... 
    end; 

procedure TMyComponent.Invalidate; 
begin 
    if (Parent <> nil) and (FParentLastWidth <> Parent.Width) then 
    begin 
    FParentLastWidth := Parent.Width; 
    // do whatever when the parent resizes 
    end; 
    inherited; 
end; 

FParentLastWidthを追加または置き換えます（親の幅が変更された場合にのみ反応が必要でした。コンポーネントに影響を与えないすべての変更に反応しないように最適化することができます）