フォームのサイズを変更するには？
目的は、フォーム上にマウスカーソルが移動するとフォームのサイズを
大きくし、フォーム外にマウスカーソルが移動するとフォームのサイズを
元に戻すようにしたいのです。
以下のようにしてみたのですが、まったく動作しません。
条件判断をなくしてみると、動作したりしなかったりまた、
フォーム上の他のコンポーネント等を移動させると
メニューが大きくなったり小さくなったりと表示されるため
フラッシュ状態？になります。
どうすればよいのでしょうか?
type
TForm1 = class(TForm)
：
private
：
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
：
end;
procedure TForm1.CMMouseEnter(var Msg: TMessage);
begin
if TComponent(Msg.LParam) = Form1 then begin
Width := 500;
Height := 500;
end;
end;
procedure TForm1.CMMouseLeave(var Msg: TMessage);
begin
if TComponent(Msg.LParam) = Form1 then begin
Width := 100;
Height := 100;
end;
end;
難しい説明はコレ
http://www2.big.or.jp/~osamu/Delphi/delphi-browse.cgi?index=060434
メッセージ処理が停止するらしいので、WM_MOUSEHOVER を使うのがいいのかもしれない。
WM_MOUSEHOVER じゃなくて、TrackMouseEventのほうかな？
お恥ずかしい
まったく動きません。
＞WM_MOUSEHOVER じゃなくて、TrackMouseEventのほうかな？
これを参考に検索して、サンプルみたいなのがあったので
作ってみたのですが、（すみません。理解せず作ってます）
やはり、まったく動きません。
どうすればよいのでしょうか？
ちなみに以下ソースです。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
private
public
end;
var
Form1: TForm1;
LPTRACKMOUSEEVENT: tagTRACKMOUSEEVENT;
implementation
{$R *.dfm}
procedure TrackMouseTimerProc(hWnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD);
var
rect: TRect;
pt: TPoint;
begin
GetClientRect(hWnd, rect);
MapWindowPoints(hWnd, NULL, rect, 2);
GetCursorPos(pt);
if (not PtInRect(rect, pt) or (WindowFromPoint(pt) <> hWnd)) then begin
if ( not KillTimer(hWnd,idEvent)) then begin
// エラーのためタイマー停止
end;
PostMessage(hWnd,WM_MOUSELEAVE,0,0);
end;
end;
function TrackMouseEvent(ptme: PTRACKMOUSEEVENT): Boolean;
begin
if ( (ptme <> Nil) or (ptme.cbSize < sizeof(tagTRACKMOUSEEVENT)) ) then begin
Result := False;
Exit;
end;
if ( not IsWindow(ptme.hwndTrack) ) then begin
Result := False;
Exit;
end;
if ( (ptme.dwFlags and TME_LEAVE) = 0 ) then begin
Result := False;
Exit;
end;
Result := (SetTimer(ptme.hwndTrack, ptme.dwFlags, 100, @TrackMouseTimerProc) <> 0);
end;
var
fInWindow: Boolean;
fInMenu: Boolean;
function MainWndProc(hWnd: HWND; uMsg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT;
var
tme: tagTRACKMOUSEEVENT;
begin
case uMsg of
WM_CREATE:
begin
fInWindow := FALSE;
fInMenu := FALSE;
Result := 0;
Exit;
end;
WM_MOUSEMOVE:
begin
if not fInWindow then begin
fInWindow := TRUE;
tme.cbSize := sizeof(tagTRACKMOUSEEVENT);
tme.dwFlags := TME_LEAVE;
tme.hwndTrack := hWnd;
if TrackMouseEvent(@tme) then begin
MessageBox(hWnd, 'TrackMouseEvent Failed', 'Mouse Leave', MB_OK);
end;
end;
end;
WM_MOUSELEAVE:
begin
fInWindow := FALSE;
if not fInMenu then begin
MessageBox(hWnd, 'Elvis has left the building', 'Mouse Leave', MB_OK);
end;
end;
WM_ENTERMENULOOP:
begin
fInMenu := TRUE;
end;
WM_EXITMENULOOP:
fInMenu := FALSE;
else
Result := DefWindowProc( hWnd, uMsg, wParam, lParam);
Exit;
end;
Result := 0;
end;
end.
あけおめことよろ。
こんな感じでどーでしょう。
すみませんが上のソースは見てません。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Menus;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
FTME:TTRACKMOUSEEVENT;
TrackLeave:boolean;
TrackHover:boolean;
procedure NewWndProc(var AMsg:TMessage);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
OldWndProc:TWndMethod;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
TrackLeave:= false;
TrackHover:= true;
FTME.cbSize := sizeof(TTRACKMOUSEEVENT);
FTME.dwFlags := TME_LEAVE;
FTME.dwHoverTime := HOVER_DEFAULT;
FTME.hwndTrack := Application.Handle;
TrackMouseEvent(FTME);
OldWndProc := WindowProc;
WindowProc := NewWndProc;
end;
procedure TForm1.NewWndProc(var AMsg:TMessage);
procedure leaveCheck;
var cPos:TPoint;
begin
cpos:=Point(0,0);
GetCursorPos(cpos);
if ((cpos.X <= Left) or (cPos.X >= Left+Width )) or
((cpos.Y <= Top ) or (cPos.Y >= Top +Height)) then
begin
Width :=200;
Height:=100;
end;
TrackLeave := false;
TrackHover := true;
end;
begin
case AMsg.Msg of
WM_NCMOUSELEAVE :leaveCheck;
WM_MOUSELEAVE :leaveCheck;
WM_MOUSEMOVE :
begin
if not TrackLeave then
begin
TrackLeave := true;
FTME.cbSize := sizeof(TTRACKMOUSEEVENT);
FTME.dwFlags := TME_LEAVE;
FTME.dwHoverTime:= HOVER_DEFAULT;
FTME.hwndTrack := Handle;
TrackMouseEvent(FTME);
end;
if TrackHover then
begin
Width :=300;
Height:=300;
TrackHover := false;
end;
end;
end;
OldWndProc(AMsg);
end;
end.
ママんさんのソース、実行レポ
マウスを高速で出入りするとＯＫ。
スロー・スピードではＮＧ。
フォームが全面パネルとかに覆われているとＮＧ。
・・・こんな感じでした。
乗ってるコントロールすべてにディスバッチしないと・・・
な感じなんですけどね、初心者なのでよくわかりません。
Variants をインクルードするとエラーが出るので削除しました。（Ｄ4）
それと WM_NCMOUSELEAVE :leaveCheck; の部分と。
これのせい？
JournalHook(ジャーナルフック)を使用した例です．
なお，他の方のコードは試していません．解説コードの中の説明ということで
省略させていただきます．
var
Form1 : TForm1;
ALeft : Integer;
ATop : Integer;
AWidth : Integer;
AHeight : Integer;
TargetWin : HWND;
JournalHook : HHOOK = 0;
MsgID : Integer;
implementation
{$R *.DFM}
//=============================================================================
// フック関数のメッセージを受取る
// ここではマウスの移動のみ処理
// マウスがFormを離れるとFormのサイズが小さくなる．小さくなったFormは，必ず元
// のFormの中に収まらなければならない．何故なら，元のFormの外側になると，
// (1) 小さくなったFormの中にマウスがくる
// (2) これはFormの中なので大きくなる
// (3) ところが，現在のマウスの位置は大きくなったFormの外側である
// (4) そこでFormは小さくなろうとする
// 以上を繰り返すので，大きいFormと小さいFormが交互に表示されることになる．
//=============================================================================
function WatchProc(nCode: Integer; wPara: WPARAM;lParam:LPARAM):LRESULT;
stdcall;
var
event : pEVENTMSG;
Pos : TPOINT;
begin
if nCode < 0 then begin
Result := CallNextHookEx(JournalHook,nCode,wPara,lParam)
end else begin
Result := 0;
if nCode = HC_ACTION then begin
event := pEVENTMSG(lParam);
case {p}Event^.Message of
WM_MOUSEMOVE: MsgID := 1;
else
MsgID := 0;
end;
if MsgID = 1 then begin
GetCursorPos(Pos);
if PtInRect(Form1.BoundsRect,Pos) then begin
Form1.SetBounds(ALeft,ATop,AWidth,AHeight);
end else begin
Form1.SetBounds(ALeft,ATop,AWidth div 2,AHeight div 2);
end;
end;
end;
end;
end;
//=============================================================================
// フックの開始
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
TargetWin := FindWindow(nil, pchar('Form1'));
if TargetWin <> 0 then begin
JournalHook :=SetWindowsHookEx(WH_JOURNALRECORD,
Addr(WatchProc),
MainInstance,
0);
ALeft := Self.Left;
ATop := Self.Top;
AWidth := Self.Width;
AHeight := Self.Height;
end;
end;
//=============================================================================
// フック終了
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
if JournalHook <> 0 then begin
UnhookWindowsHookEx(JournalHook);
JournalHook := 0;
end;
end;
//=============================================================================
// Formがなくなるときはフック終了
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
Button2Click(Sender);
end;
end.
WM_NCMOUSELEAVE :leaveCheck;
これがスロースピードの時の検出メッセージです。
CM_MOUSELEAVEで代用可能です。
ちなみに私の例はTrackMouseEventの使用例っぽいものですので、
あくまでTrackMouseEventを使うならこんな感じ的のものです。
私はコントロール上にマウスがあるかの判断はTrackMouseEventが作法的に礼儀正しい気がしますが、タイマーやJournalHookでももちろん可能です。
初心者だったらタイマーでいいんでないっすか？
| ツイート |  |