Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年01月05日] [更新 2020年04月15日]　Delphi サンプルプログラム集
124_フォームの移動リサイズ制御関係
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
124_FormResizeMove.zip　[4,799 KB]　2020年04月15日版 (EXE 同梱)






フォームの移動リサイズ制御関係


フォームの移動リサイズに関する参考コードです．
Windows には [Win] + [M} のキー操作で全てのウィンドウを最小化する機能がありますが，本ページにはこの操作で最小化しないサンプルがあります．実際に操作して確認してください．


[備考]
キーフックを使用すると，全てのウィンドウを最小化する [Win] + [M} のキー操作を無効にすることができます．自アプリだけで [Win] + [M} を無効にするにはローカルキーフックを，システム全体で [Win] + [M} を無効にするにはグローバルキーフックを使用します．





01_BorderIcons プロパティによるキャプションバーのアイコン設定


フォームの最小化，最大化の可否は BorderIcons プロパティでも設定できます．
下図は BorderIcons プロパティのデフォルトの設定です．biMinimize と biMaximize の値が True になっています．この設定では最小化と最大化のボタンが表示され，最小化ができます．また，キャプションバーをダブルクリックすれば最大化できます．


図1
BorderIcons プロパティのデフォルト設定値
図2
上の図の設定における実行時のフォーム
  • キャプションバーの右端のボタンは左から
    [最小化] ボタン
    [最大化] ボタン
    [閉じる] ボタン
  • 最大化している時は，[最大化] ボタンは [元に戻す] ボタンとなる

下図は biMinimize と biMaximize の値を Flase にした結果です．[最小化] ボタンと [最大化] ボタンがないので最小化も最大化もできなくなります．[Win] + [M] でも最小化ができなくなります．

この状態は，マウス操作，フォームのシステムメニュー (キャプションバーの左端のフォームのアイコンクリックで現れるメニュー) で最小化や最大化ができなくなっただけで，最小化や最大化のコードを実行すれば最小化も最大化も可能です．最小化も最大化もできなくするには，つまり，リサイズ不可にする方法は，後述のサンプルを参考にしてください．



図3
biMinimize と biMaximize を False にする
図4
上の図の設定における実行時のフォーム
  • [最小化] と [最小化] ボタンが非表示となるので最小化も最大化もできなくなる

biSystemMenu の値を False にすると下図のようになり，フォーム上の操作では閉じないようにすることができます．ただし，フォームの左上のアイコンも表示されなくなります．

フォームのスタイルが変わりますが，BorderStyle プロパティでも最小化，最大化が出来ないダイアログ形式のフォームにできます．


図5
BorderIcons の biSystemMenu を False にした状態

BorderIcons プロパティのように，複数の論理型のメンバを持つプロパティを集合型のプロパティと言います．集合型のプロパティを実行時に設定するには，以下のコードのように，[] 内に True にしたいメンバの値を記述します．
BorderIcons プロパティの場合，最小化と最大化の両方を無効にしないと，それらのボタンは非表示とはなりません．Enabled プロパティが False の時と同じ無効表示の状態になるだけです．



図6
Button1 クリック
  • 最小化と最大化のポンタは非表示となる
図7
Button2 クリック
  • 最小化のボタンは無効化状態の表示となる
 

//=============================================================================
//  集合型のプロパティを実行時に設定する方法
//  []内ににTrueにするメンバの値を , (カンマ)で区切って記述する
//  以下は1つだけの場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Self.BorderIcons := [biSystemMenu];
end;

//=============================================================================
//  集合型のプロパティを実行時に設定する方法
//  []内ににTrueにするメンバの値を , (カンマ)で区切って記述する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Self.BorderIcons := [biSystemMenu, biMaximize];
end;



02_WindowStateプロパティによるフォームの最小化と最大化


フォームの最小化と最大化は WindowStateプロパティで設定てきます．
以下はその簡単なテスト用コードです．

このプロパティを使用すると，フォームのキャプションバー (タイトルバー) の右側の最小化等のアイコンがなくても最小化，あるいは最大化できます．
フォームの最小化，最大化などのリサイズは，OnResize イベントで検出できます．



図8
WindowState によるフォームの最小化と最大化
図9
キャプションバーの最小化等のボタンがなくても最小化や最大化が可能

リスト1
WindowStateプロパティによるフォームの最小化と最大化		 
//=============================================================================
//  自分自身を最小化する
//  タスクバーのアイコンをクリックすると元に戻る
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Self.WindowState := wsMinimized;
end;

//=============================================================================
//  自分自身を最大化する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Self.WindowState := wsMaximized;
end;

//=============================================================================
//  元に戻す
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  Self.WindowState := wsNormal;
end;  

//=============================================================================
//  Form1のOnResizeイベント処理
//  フォームのサイズが変更された時(フォームのリサイズの時)に発生するイベント
//=============================================================================
procedure TForm1.FormResize(Sender: TObject);
begin
  if Self.WindowState = wsMinimized then begin
    //最小化した時の処理
  end else
  if Self.WindowState = wsMaximized then begin
    //最大化した時の処理
  end else
  if Self.WindowState = wsNormal then begin
    //元のサイズになった時の処理
  end;
end;



03_位置とサイズの設定をする時は Position を poDesigned にする


実行時にコードでフォームの表示位置を変更するためには，一般的にフォームの Position プロパティの値を poDesigned にします．
以下の Button1 クリックのコードは，オブジェクトインスペクタでフォームのサイズを設定している状態を想定しています．オブジェクトインスペクタでフォームのサイズを設定しても，poDefault ではサイズが反映されないことになります．


図10
Position プロパティの設定

リスト2
フォームの位置とサイズの設定をする時は，基本的には Position を poDesigned にする 
//=============================================================================
//  Position := poDefaultの時
//  左端と状態の位置は指定通りになるがサイズはWindowsが設定する
//  フォームを作成した時のデフォルトはpoDefaultPosOnly
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Self.Width  := 400;
  Self.Height := 250;

  Self.Position := poDefault;

//  ここで設定すればサイズも設定可能
//  Self.Width  := 400;
//  Self.Height := 250;

  Self.Left := 100;
  Self.Top  := 50;
end;

//=============================================================================
//  Position := poDesignedの時
//  位置もサイズも指定通りになる(デザインが有効になる)
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Self.Width  := 400;
  Self.Height := 250;

  Self.Position := poDesigned;

  Self.Left := 100;
  Self.Top  := 50;
end;



04_フォームのリサイズを制限  -  Constraints プロパティ


Form の Constraints プロパティを使用して，フォームのサイズ変更を制限します．
フォーム等，TControl のサイズの制限は，OnConstrainedResize イベント内でも設定できます．コントロールのリサイズの禁止は，後述の OnCanResize イベントでも設定できます．


図11
設計時画面
図12
最大化時
  • 最大化すると画面左上に表示

リスト3
フォームのリサイズを制限 
unit MaxMinSizeUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  サイズを指定
//  ここで指定しているサイズ以上，以下にはならない
//  最大化の場合，左上(0,0)に表示される
//
//  実際の利用ではフォームのシステムメニューも使用不可にしておいた方がよい
//  (メニューに該当項目があるのに不可なのはおかしい)
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Constraints.MaxHeight := 450;
  Constraints.MaxWidth  := 450;
  Constraints.MinHeight := 150;
  Constraints.MinWidth  := 250;
end;

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

end.



05_フォームのリサイズを制限  -  WM_GETMINMAXINFOメッセージ


上のサンプルと同じく，フォームのサイズ変更を制限しますが，このサンプルでは WM_GETMINMAXINFO メッセージを処理しています．このサンプルのコードでも [最大化] ボ タンでは，画面の左上に表示されますが，メッセージ内の処理を変更することで，画面の任意の位置に表示することができます．
また各メッセージのパラメータに現在のフォームのサイズに相当する値を指定すると，リサイズ不可のフォームとすることができます．
ただし，構造体 (レコード型) の各メンバの設定には若干の注意があります．


図13
設計時画面
図14
最大化時
  • 最大化すると画面左上に表示

リスト4
フォームのリサイズを制限 
unit MaxMinSizeMessageUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
      message WM_GETMINMAXINFO;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  サイズを指定
//  ここで指定しているサイズ以上，以下にはならない
//  最大化の場合，左上(0,0)に表示される
//  最大化の時の位置はptMaxPosition.x,ptMaxPosition.yで設定可能
//
//  実際の利用ではフォームのシステムメニューも使用不可にしておいた方がよい
//  (メニューに該当項目があるのに不可なのはおかしい)
//=============================================================================
procedure TForm1.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
  //元の動作を実行
  inherited;

  Message.MinMaxInfo.ptMinTrackSize.x := 200;
  Message.MinMaxInfo.ptMinTrackSize.y := 150;

  Message.MinMaxInfo.ptMaxTrackSize.x := 450;
  Message.MinMaxInfo.ptMaxTrackSize.y := 450;
end;

end.


一般的には，ウィンドウのサイズはデスクトップのサイズを超えることはできません．
この WM_GETMINMAXINFO メッセージを処理するとこの制限を超えることができます．以下のコードを実行すると，EXE の実行開始時にフォームの幅を 3000 にします．左端は画面の左端になります．デスクトップの幅が 3000 以上あるモニタでは意味のないサンプルです．

このコードは，最大化，最小化の時の位置とサイズはデフォルトの値のままです．それらの値も設定しておかないと最大化した時等に違和感がある表示になるでしょう．


リスト5
デスクトップのサイズを超えるサイズのフォーム		 
unit MaxMinSizeMessageUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
      message WM_GETMINMAXINFO;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Types;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Width := 3000;
end;

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

procedure TForm1.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
  inherited;

  Message.MinMaxInfo.ptMinTrackSize := Point(-3000, -3000);
  Message.MinMaxInfo.ptMaxTrackSize := Point(5000, 3500);
end;

end.



06_リサイズ不可のフォーム


フォームの BorderStyle プロパティの値を bsDialog または bsToolWindow にするとリサイズできなくなります．その場合，キャプションバーの左端のアイコンは表示しません．
キャプションバーのアイコンを表示した状態でリサイズできなくするには，TForm の OnCanResize イベントの引数の Resize の値を False にします．このテストプログラムです．


図15
設計時画面

この方法でフォームのサイズが変更できないようにしても，マウスカーソルは下図の最初の画像のようにリサイズ用のままです．そこで，このサンプルでは WM_NCHITTEST メッセージを使用して，マウスカーソルの形状を変更しています．また，システムメニューから [サイズ変更] を削除しています．


図16
リサイズを不可にしただけの状態
  • リサイズ用のマウスカーソルになっている
図17
マウスカーソルを変更

リスト6
フォームのリサイズを不可にする		 
unit InhibitResizeUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
      var Resize: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LhSysmenu : hMenu;
begin
  // フォームのシステムメニューのハンドルを取得
  LhSysmenu := GetSystemMenu(Handle, False);
  // [サイズ変更] のメニューを削除
  DeleteMenu(LhSysmenu, SC_SIZE, MF_BYCOMMAND);
end;

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  FormのOnCanResizeイベントでリサイズを禁止
//  サイズの指定も可能
//
//  実際の利用ではフォームのシステムメニューも使用不可にしておいた方がよい
//  (メニューに該当項目があるのに不可なのはおかしい)
//=============================================================================
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  Resize := False;
end;

//=============================================================================
//  WM_NCHITTEST メッセージ処理
//  マウスカーソルの位置に応じて位置情報を誤魔化す
//  ほとんどの場合，全ての以下だけにしても問題ないことが多い
//    Message.Result := htBorder;
//=============================================================================
procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
  // 継承元 (TForm) にはこのメッセージはないので実際には不要
  Inherited;

  Case Message.Result of
    htLeft        : Message.Result := htBorder;
    htRight       : Message.Result := htBorder;
    htBottomLeft  : Message.Result := htBottom;
    htBottomRight : Message.Result := htBottom;
    htTopLeft     : Message.Result := htTop;
    htTopRight    : Message.Result := htTop;
  end;
end;

end.



07_移動不可のフォーム


WM_WINDOWPOSCHANGING メッセージを処理して，フォームの移動をできなくします．ただし，このメッセージは，フォーム作成時から発生するため，このサンプルプログラムのコードのままでは，表示位置は設計時のままとなります．フォームの表示位置を設計時のままにしておきたい場合に利用できます．


図18
設計時画面

リスト7
フォームの移動を不可にする 
unit InhibitMoveUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging);
      message WM_WINDOWPOSCHANGING;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  フォームの移動を禁止
//  左端と上端の位置を今のままとする
//  このフォームはPositionプロパティをpoMainFormCenterにしてあるが，フォーム生
//  成時からこのWM_WINDOWPOSCHANGINGが発生するので，設計時のままとなる
//
//  実際の利用ではフォームのシステムメニューも使用不可にしておいた方がよい
//  (メニューに該当項目があるのに不可なのはおかしい)
//=============================================================================
procedure TForm1.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
  Message.WindowPos.x := Left;
  Message.WindowPos.y := Top;

  Message.Result := 0;
end;

end.



08_移動リサイズ不可のフォーム


筆者が比較的よく利用する方法です．WM_SYSCOMMAND メッセージを処理する方法です．移動またはリサイズだけを不可にすることも簡単にできます．
このサンプルコードでは，チェックボックスのチェックを外せば移動リサイズが可能となります．


図19
設計時画面

リスト8
フォームの移動とリサイズを不可にする 
unit InhibitResizeMoveUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  移動(SC_MOVE)とリサイズ(SC_SIZE)を禁止
//  WM_SYSCOMMANDメッセージを処理
//  下位4ビットは内部的に使用されている可能性があるので$FFF0のandで検査
//
//
//  実際の利用ではフォームのシステムメニューも使用不可にしておいた方がよい
//  (メニューに該当項目があるのに不可なのはおかしい)
//=============================================================================
procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
begin
  if (Message.CmdType and $FFF0) = SC_MOVE then begin
    if CheckBox1.Checked then begin
      Message.Result := 0;
    end else begin
      inherited;
    end;
  end else
  if (Message.CmdType and $FFF0)= SC_SIZE then begin
    if CheckBox1.Checked then begin
      Message.Result := 0;
    end else begin
      inherited;
    end;
  end else begin
    //移動リサイズ以外はデフォルト動作
    inherited;
  end;
end;

end.



09_フォームの横または縦方向の移動禁止


WM_MOVING メッセージを処理して，フォームの移動方向を横または，縦方向に制限するサンプルコードです．


図20
設計時画面

リスト9
フォームの横または縦方向の移動禁止 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
    InhibitFlag : Integer;
  protected
    procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム作成時の処理
//  移動禁止フラグをセット
//  InhibitFlag = 0 の時は移動自由
//  InhibitFlag = 1 の時は横方向移動禁止
//  InhibitFlag = 2 の時は縦方向移動禁止
//  とする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  InhibitFlag := 0;
end;

//=============================================================================
//  横方向の移動禁止とする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  InhibitFlag := 1;
end;

//=============================================================================
//  縦方向の移動禁止とする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  InhibitFlag := 2;
end;

//=============================================================================
//  禁止を解除する
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  InhibitFlag := 0;
end;

//=============================================================================
//  フォームを移動しようとする時のメッセージ処理
//=============================================================================
procedure TForm1.WMMoving(var Message: TWMMoving);
begin
  //横方向移動禁止
  if InhibitFlag =1  then begin
    Message.DragRect^.Left  := Left;
    Message.DragRect^.Right := Left + Width;
  end;

  //縦方向移動禁止
  if InhibitFlag =2  then begin
    Message.DragRect^.Top    := Top;
    Message.DragRect^.Bottom := Top + Height;
  end;
end;

end.



10_キャプション ( タイトル ) バーのないフォームの移動リサイズ


キャプションバー (タイトルバー) のないフォームの移動とリサイズを可能する例です．移動はフォームのクライアント領域のマウスドラッグで操作します．
本サンプルは，Form1 の オブジェクトインスペクタで BorderStyle の値を bsNone にして，キャプションバー (タイトルバー) がないウィンドウにしています．


図21
実行時画面

リスト10
キャプションバーのないフォームの移動とリサイズを可能にする
Form1 の BorderStyle の値を bsNone にしている		 
unit ResizeMoveNonCaptionBarUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure CreateParams(var Params : TCreateParams); override;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  このフォームは，オブジェクト・インスペクタでBorderStyleをbsNoneにしている
//  つまりキャプション(タイトル)バーのないフォームとなっている
//
//  フォームのCreateParamでウィンドウのスタイルを設定
//  リサイズを可能にする
//
//  [参考]
//  キャプションバーの高さ GetSystemMetrics(SM_CYCAPTION)
//  ウィンドウ(フレーム)枠の太さ GetSystemMetrics(SM_CYFRAME)
//=============================================================================
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  Params.Style := WS_THICKFRAME or WS_POPUP or WS_BORDER;
end;

//=============================================================================
//  WM_NCHITTESTメッセージ処理
//  ウィンドウの移動を可能にする
//
//  Windowsからの戻り値がHTCLIENT(クライアント領域内)だったら、HTCAPTION(キャプ
//  ションバー上にある)という戻り値に設定してWindowsをだます。
//=============================================================================
procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
  inherited;

  if( HTCLIENT = Message.Result )then begin
    Message.Result := htCaption;
  end;
end;

end.