カスタムコンポーネントで親フォームの移動を検知したい

解決

---

度々ここで質問させていただいてます。
諸先輩の皆様、いつも回答ありがとうございます。

TCustomEdit派生のカスタムコンポーネントを作成し、TEditのNumbersOnlyプロパティを拡張したような機能を持たせようとしています。
キー入力や貼り付けで許可しない入力をエラーにする（バルーン表示）、というものです。

入力を検証してエラー表示するところまでは同じような動作にすることができましたが、エラー表示をフォーム移動時に消す方法がわかりません。
TEditのNumbersOnlyプロパティを使用した場合はフォームの移動でエラー表示が消えますが、このような動きはどう実現したら良いのでしょうか。

親フォームの移動を子コンポーネントで検出する方法があるのでしょうか。
エラー表示はCreateWindow(TOOLTIPS_CLASS, nil, TTS_BALLOON, ...)で行っています。

環境はDelphi XEです。

編集 削除

---

こんばんは、KONです。

> 親フォームの移動を子コンポーネントで検出する方法があるのでしょうか。 

どの様なエラー表示（オリジナルのバルーン？）なのかは判りませんが、
単に親フォームの移動を検知して子コンポーネントに知らせるのでしたら、
親フォームでWM_MOVEメッセージをトラップして、
オリジナルのメッセージ（例：WM_USER + $100）でも作って、
その関数でエラー表示がなされていれば、消去しなさいという処理を
行えば良いのかも？

[VCLコード]
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

const
  WM_CLEARBALLOON = WM_USER + 100;

type
  TMyEdit = class( TCustomEdit )
    procedure WMClearBalloon( var Message : TMessage ); Message WM_CLEARBALLOON;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  TForm1 = class( TForm )
    procedure FormCreate    ( Sender : TObject );
    procedure FormDestroy   ( Sender : TObject );
    procedure FormWMMove    ( var Msg : TWMMove ); Message WM_MOVE;
  private
    { Private 宣言 }
    Edit1 : TMyEdit;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate( Sender : TObject );

begin
  Edit1         := TMyEdit.Create( Self );
  Edit1.Parent  := Self;
  Edit1.Left    := ( Self.Width  div 2 ) - ( Edit1.Width  div 2 );
  Edit1.Top     := ( Self.Height div 2 ) - ( Edit1.Height div 2 );
  Edit1.Text    := '';
  Edit1.Visible := TRUE;
  Edit1.Tag     := 0;
end;

procedure TForm1.FormDestroy( Sender : TObject );

begin
  FreeAndNil( Edit1 );
end;

procedure TForm1.FormWMMove( var Msg : TWMMove );

begin
  inherited;
  if Self.Visible then
  begin
    SendMessage( Edit1.Handle, WM_CLEARBALLOON, WPARAM( 0 ), LPARAM( 0 ) );
  end;
end;  

procedure TMyEdit.WMClearBalloon( var Message : TMessage );

begin
  // エラー表示がされていれば消去する処理
end;

end.

ハズしてたらすみません。

編集 削除

---

ちょっと訂正を^^;

自分の子コンポーネントなら、わざわざWindowメッセージにする必要性はないですね。
親フォームのWM_MOVEで表示の有無を判定し、子コンポーネントの関数やメソッドを
呼ぶだけで良いです。

編集 削除

---

KONさん、ありがとうございます。

親フォームから子コンポーネントに通知するのではなく、カスタムコンポーネント内で親フォームの移動を検知したいのですができないでしょうか。
フォームにコードを追加することなく、カスタムコンポーネントを設置するだけで動作するようにしたいです。
TEditのNumbersOnlyプロパティをTrueにした時、数字以外を入力すると表示されるバルーンと同じ動作をイメージしています。

エラー表示は具体的には以下のようなコードになっています。

procedure THogeEdit.ShowBallonTip(title, msg: string);
var
  ti: TOOLINFO;
  pt: TPoint;
begin
  // FTipWndはprivateメンバです
  if FTipWnd <> 0 then begin
     DestroyWindow(FTipWnd);
  end;

  FTipWnd := CreateWindow(TOOLTIPS_CLASS, nil, TTS_BALLOON, 0, 0, 0, 0, Self.Handle, 0, HInstance, nil);

  // 表示位置(pt)の計算処理がありますが略

  ti.cbSize := SizeOf(ti);
  ti.uFlags := TTF_TRACK;
  ti.hwnd := Self.Handle;
  ti.lpszText := PChar(msg);

  SendMessage(FTipWnd, TTM_ADDTOOL, 0, Integer(@ti));
  SendMessage(FTipWnd, TTM_SETTITLE, TTI_ERROR, Integer(PChar(title)));
  SendMessage(FTipWnd, TTM_TRACKPOSITION, 0, MAKELONG(pt.X, pt.Y));
  SendMessage(FTipWnd, TTM_TRACKACTIVATE, 1, Integer(@ti));

  SetTimer(FTipWnd, TIMER_ID_CLOSE, 10000, @Timerproc);
end;

編集 削除

---

同じ動作にしたいのであれば、自分でCreateWindowせずにEM_SHOWBALLOONTIPメッセージでバルーンを表示してください。

編集 削除

---

jazzさん

EM_SHOWBALLOONTIPの存在を知りませんでした・・・。
調べ方が足りなかったようです。

希望通りの動作になりました。
ありがとうございました！

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。

返信する