フォームのサイズを変更するには？ (ID:19504)

名前

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

本文

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.

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

戻る