Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2006年01月10日] [更新 2014年05月18日]　Delphi サンプルプログラム集
   
710_SDI スタイルのアプリケーション
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
Delphi 2007 以降専用コード
710_SDIStyleApp.zip　[1,636 KB]　2014年05月18日版 (EXE 同梱)



  • 2006年01月11日
  • ウィンドウ整列の際，前面に表示されないウィンドウがある現象を修正
  • 2014年05月18日
  • Delphi 2007 以降専用のコードに変更
  • UIPI (ユーザーインタフェイス特権の分離) 対応コードを追加
  • サブフォームを子フォームという名称に変更
  • 解説的な記事を追加



SDI スタイルのアプリケーション


中村の里の [SDI スタイル] の解説記事を元にしたサンプルプログラムです．
中村の里の記事を要約して再掲すると，秀丸エディタのような SDI (Single Document Interface ) ウィンドウスタイルのアプリケーションは，
  • メインのウィンドウ (フォーム) はない
  • 各々の文書ウィンドウは同じメニューを持っていて対等である
  • 各ウィンドウはタスクバーに表示され，独立して最小化や最大化が可能
  • 各ウィンドウはタスクマネージャに表示され，[Alt] + [Tab] で切替えられる
  • すべてのウィンドウが閉じるとアプリケーションが終了する
となっています．かってはワードやエクセルも同じような仕様となっていたことがあります．
本ページのサンプルは，このような SDI スタイルのアプリケーションを作成します．

2014年05月18日の更新で，Delphi 2007 以降専用のコードにしました．Delphi 2007 よりも前のバージョンで使用するには，コードの修正が必要です．


Delphi 2007 よりも前で使用するには，[Delphiで、Windows Vista Readyアプリケーションを作る] にある以下の記事を参考にしてください．





01_Delphi の 新規作成の SDI アプリケーション


秀丸エディタのような SDI スタイルのアプリを作成する前に，Delphi の SDI アプリを復讐しておくことにします．
Delphi で新規に作成する VCL フォームアプリケーションは SDI アプリケーションです．このアプリケーションは，
  • メインのウインドウ (フォーム) があり，これを閉じるとアプリケーションが終了する
  • メインウィンドウ以外はタスクバーにボタンを表示しない
  • メインウィンドウ以外のウインドウは最小化するとデスクトップの隅に行く
  • メインフォームを最小化すると，すべてのウィンドウが非表示になる
  • タスクマネージャには，見えないアプリケーションウィンドウだけが表示される
という仕様になっています．
下図の下のコードは，このことを確認するためのサンプルです．メインフォームから，ボタンクリックで子フォームを表示します．
この動作は，プロジェクトソースの MainFormOnTaskbar の値によっても変化します．Delphi 2007 よりも前のバージョンではアプリケーションウィンドウの挙動が曖昧でしたが，Delphi 2007 で明確になり，扱いやすくなりました．参考リンクの記事に，この MainFormOnTaskbar の値を使用したサンプルがあります．


図1
複数のフォームを表示するアプリ
  • 複数のフォームを表示しても，タスクバーのボタン (アイコン) は 1 つだけ
図2
子フォームを最小化
  • 隅の方に最小化して表示される

上の図の状態で，メインフォームを最小化します．すると，画面にフォームは表示しなくなります．タスクバーには，メインフォームだけのボタン (アイコン) が表示されます．
メインフォームを閉じると，アプリケーションが終了します．子フォームだけを閉じてもアプリケーションは終了しません．


図3
メインフォームを最小化する
  • 子フォームも画面に表示されない
図4
メインフォームを閉じる
  • アプリケーションが終了する

リスト1
Delphi の新規 VCL フォームアプリケーション (SDI アプリ) のテスト		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3, Unit4;

{$R *.dfm}

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

procedure TForm1.Button2Click(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Form4.Show;
end;

end.



02_Delphi の MDI アプリケーション


複数のフォームを扱うアプリには，MDI (Multiple Document Interface) アプリもあります．
MDI アプリは，下図のように，フォーム内に，複数のフォームを表示するものです．
このサンプルは，これの簡単な例です．


図5
MDI アプリケーションの例

リスト2
MDI アプリのメインフォームのコード 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure CreateChildForm(const childName: string);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

//=============================================================================
//  MDIの子ウィンドウを生成する
//  このメインフォームのFormStyleはfsMDIFormとしている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateChildForm('Child ' + IntToStr(MDIChildCount + 1));
end;

//=============================================================================
//  表示している子フォームのWindowStateをwsNormalにする
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  i : Integer;
begin
  for i := 0 to MDIChildCount - 1 do begin
    MDIChildren[i].WindowState := wsNormal;
  end;
end;

//-----------------------------------------------------------------------------
//  MDIの子ウィンドウを生成するためのメソッド
//  処理の追加を考慮して，ボタンクリックではなく専用のメソッドとしている
//
//  子ウィンドウのFormStyleはfsMDIChildにしている
//  また，[自動生成]のチェックを外し，実行時生成にしている
//-----------------------------------------------------------------------------
procedure TForm1.CreateChildForm(const ChildName: string);
var
  Child: TForm2;
begin
  Child := TForm2.Create(Application);
  Child.Caption := ChildName;
end;

end.


リスト3
MDI アプリの子フォームのコード 
//=============================================================================
//  子フォームを閉じる時は，解放
//
//  この子フォームのFormStyleはfsMDIChildにしている
//  また，[自動生成]のチェックを外し，実行時生成にしている
//=============================================================================
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;


Delphi の新規作成用のテンプレートに MDI アプリケーションがあります．
[ファイル] [新規作成] [その他] で選択できます．下の図は，実際にプロジェクトを作成して実行した結果です．



図6
MDI アプリケーションのテンプレート




03_SDI スタイルのサンプルプログラムの仕様


作成した SDI スタイルのアプリケーションの設計時と，実行結果の図です．
コードは次項以降に掲載しています．

ここでは，各々の SDI フォームを「子フォーム」と呼ぶことにします．アプリケーションを起動すると，メインフォームは表示しないで，子フォームを 1 つだけ作成して表示します．この子フォームにはメニューがあり，このメニューから，別の子フォームを生成したり，ウィンドウの整列表示を行います．各々の子フォームは同じプロセス内のウィンドウとなります．
二重起動はできないようにしています．二重起動しようとすると，起動中のプロセスの 1 つのウィンドウとしての子フォームを作成するようになっています．

IDE から実行すると，Delphi のバージョンによっては，期待する動作をしない場合があります．その場合は，EXE を直接実行してください．


図7
メインフォームの設計時画面
  • クラス名は TSDIMainForm
  • 実行時には非表示
図8
子フォームの設計時画面
  • クラス名は TSDIChildForm
  • 実行時にこれを複数表示する
図9
子フォームの [ファイル] メニュー
図10
子フォームの [表示] メニュー

実際の実行画面です．タスクバーに子フォームの数だけボタン (アイコン) が表示されています．


図11
[重ねて表示] の結果
図12
[左右に並べて表示]
図13
同じ [左右に並べて表示]
  • 子フォームの数が多いとこうなる

タスクマネージャーで，アプリケーションとプロセスを確認してみます．


図14
プロセスは 1 つだけ
  • このプロセスを終了すると，子フォームを全て閉じてアプリが終了する
図15
子フォームの数だけタスクがある
  • 選択したタスクを終了すると，その子フォームが閉じる




04_SDI スタイルアプリのプロジェクトのソースコード


作成した SDI スタイルアプリのプロジェクトのソースコードです．
Application.ShowMainForm := False; にして，メインフォームを表示しないようにしています．そうすると．フォームが 1 つだけのアプリの場合は，タスクバーにアプリケーションウィンドウのボタン (アイコン) が表示されます．本アプリでは，起動時に必ず子フォームを表示します．フォームが表示されれば，そのフォームのアイコンがタスクバーに表示され，アプリケーションウインドウのアイコンは表示されません．

また，二重起動を防止しています．二重起動しようとすると，すでに起動中のプロセスの 1 つのウィンドウとして子フォームを作成して表示します．この処理は，メインフォームにメッセージを送信することで行います．


リスト4
SDI スタイルアプリのプロジェクトのソース 
program SDIStyleApp;

uses
  Forms,
  dialogs,
  Windows,
  Messages,
  SDIMainFormUnit in 'SDIMainFormUnit.pas' {SDIMainForm},
  SDIChildFormUnit in 'SDIChildFormUnit.pas' {SDIChildForm};

{$R *.RES}

const
  UniqueName:string = 'Mr.XRAYSDIApp';

var
  hWindow : THandle;

//-----------------------------------------------------------------------------
//  すでに本アプリが起動中かを調査
//  起動中ならTrueを返す
//-----------------------------------------------------------------------------
function IsRunningThisApp(Name:string):Boolean;
begin
  Result := False;

  CreateMutex(nil, True, PChar(Name));
  if GetLastError = ERROR_ALREADY_EXISTS then Result := True;
end;

//-----------------------------------------------------------------------------
//  既に本アプリが起動中の場合
//      起動中の本アプリのハンドルを取得
//  　　前面に移動してSendMessageでWM_USER+50のメッセージを送る
//      起動中のアプリではWM_USER+50を受取ったら何かの処理を行う
//      本アプリでは「何かの処理」は新しい子フォームの作成
//
//  まだ本アプリが起動していない場合
//      メインフォームを非表示で作成して，子フォームを1つ作成
//-----------------------------------------------------------------------------
begin
  if IsRunningThisApp(UniqueName) then begin

    hWindow := FindWindow('TSDIMainForm', nil);
    SetForegroundWindow(hWindow);

    //新規に子フォームを生成する
    //メッセージで処理しないと例外が発生する
    SendMessage(hWindow, WM_USER + 50, 0, 0);
  end else begin
    SetProp(Application.Handle, PChar(UniqueName), 1111);
    Application.Initialize;

    //Delphi2007以上
    {$IF CompilerVersion > 18.49}
    Application.MainFormOnTaskbar := True;
    {$IFEND}
    Application.CreateForm(TSDIMainForm, SDIMainForm);
    //メインフォームは非表示とする
    Application.ShowMainForm := False;
    Application.Run;
    RemoveProp(Application.Handle, PChar(UniqueName));
  end;
end.



05_SDI スタイルアプリのメインフォームのコード


メインフォームのコードです．
このメインフォームは，実際には表示しません．子フォームのメニューで [新規] を選択すると，このメインフォームのメソッドを実行して子フォームを作成します．

EXE を管理者権限で実行するとします．その後，同じ EXE を一般ユーザで起動すると，UIPI (ユーザーインタフェイス特権の分離) の機能により，新規に子フォームを作成することはできません．そこで，この対応コードを追加しています．


リスト5
SDI スタイルアプリの，メインフォームのコード 
unit SDIMainFormUnit;

interface

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

type
  TSDIMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    ChildFormCount : Integer;
    procedure CreateChildForm;
    procedure WMUserMessage(var msg: TMessage);message WM_USER + 50;
  end;

function ChangeWindowMessageFilter(msg: Cardinal; dwFlag: DWORD): BOOL;
  stdcall; external 'user32.dll'; stdcall;

var
  SDIMainForm: TSDIMainForm;

implementation

uses SDIChildFormUnit;

{$R *.DFM}

//=============================================================================
//  Formの作成時の処理
//  子フォームを1つ作成する
//=============================================================================
procedure TSDIMainForm.FormCreate(Sender: TObject);
const
  MSGFLT_ADD = 1;
  MSGFLT_REMOVE = 2;
  WM_COPYGLOBALDATA = $0049;
begin
  //UIPI対応コード
  //本フォームでWM_USER+50メッセージの受信を可能にする
  ChangeWindowMessageFilter(WM_USER+50, MSGFLT_ADD);

  ChildFormCount := 0;
  CreateChildForm;
end;

//=============================================================================
//  実際に表示する子フォームの生成
//  このフォーム作成時と，子フォームの[新規]で呼出して実行する
//  子フォームをいくつ作成したかをChildFormCountに記録しておく
//=============================================================================
procedure TSDIMainForm.CreateChildForm;
var
  AForm   : TSDIChildForm;
  StrText : String;
begin
  inc(ChildFormCount);
  StrText := 'SDIアプリサンプル [' + IntToStr(ChildFormCount) + ']';
  AForm   := TSDIChildForm.Create(Self);

  AForm.Show;
  AForm.Caption := StrText;
end;

//=============================================================================
//  WM_USER+50メッセージを受取ったらサブフォームを新規作成
//  プロジェクトのソースコード参照
//=============================================================================
procedure TSDIMainForm.WMUserMessage(var msg: TMessage);
begin
  CreateChildForm;
end;

end.



06_SDI スタイルアプリの子フォームのコード


子フォームでの処理は，ほとんどがメニューを選択した時の処理です．
この子フォームのボタン (アイコン) をタスクバーに表示するために，CreateParams メソッドで，この子フォームの親をデスクトップウィンドウにしています．ウィンドウの親をデスクトップにすると，そのウインドウのボタン (アイコン) がタスクバーに表示されます．


リスト6
SDI スタイルアプリの子フォームのコード 
unit SDIChildFormUnit;

interface

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

type
  TSDIChildForm = class(TForm)
    MainMenu1: TMainMenu;
    menuFile: TMenuItem;
    menuNewForm: TMenuItem;
    N1: TMenuItem;
    menuClose: TMenuItem;
    menuCloseAll: TMenuItem;
    menuDisplay: TMenuItem;
    menuCascadeWindow: TMenuItem;
    menuTileVertical: TMenuItem;
    menuTileHorizontal: TMenuItem;
    menuMinimizedAll: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure menuNewFormClick(Sender: TObject);
    procedure menuCloseClick(Sender: TObject);
    procedure menuCloseAllClick(Sender: TObject);
    procedure menuCascadeWindowClick(Sender: TObject);
    procedure menuTileVerticalClick(Sender: TObject);
    procedure menuTileHorizontalClick(Sender: TObject);
    procedure menuMinimizedAllClick(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    function GetClassNameStr(hWindow: HWND): string;
  public
    { Public 宣言 }
  end;

var
  SDIChildForm: TSDIChildForm;
  NotFirstForm: Boolean;


implementation

uses SDIMainFormUnit;

{$R *.DFM}

//-----------------------------------------------------------------------------
//  最後に閉じられるフォームかをチェック
//  最後の場合はTrueを返し，そうでない場合はFalseを返す
//-----------------------------------------------------------------------------
function IsLastForm(Form: TForm): Boolean;
var
  i     : Integer;
  AForm : TForm;
  Flag  : Boolean;
begin
  Result :=  True;

  for i := 0 to Screen.FormCount - 1 do begin
    AForm := Screen.Forms[I];

    Flag := (AForm.ParentWindow = 0)
            or AForm.HandleAllocated
            or not IsChild(AForm.Handle, AForm.ParentWindow);
    if (AForm <> Form) and AForm.Visible and Flag then begin
      Result := False;
      Break;
    end;
  end;
end;

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TSDIChildForm.FormShow(Sender: TObject);
begin
 if not NotFirstForm then begin
   NotFirstForm := True;
   //最初に表示するフォームはCmdShowに従う
   case CmdShow of
     SW_SHOWMINNOACTIVE: WindowState := wsMinimized;
     SW_SHOWMAXIMIZED:   WindowState := wsMaximized;
   end;
 end;
end;

//=============================================================================
//  このフォームを閉じる時の処理
//  このフォームが最後であればアプリケーションを終了
//  if IsLastForm(Self) then SDIMainForm.Close; でもOK
//=============================================================================
procedure TSDIChildForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
  if IsLastForm(Self) then SDIMainForm.Close;
end;

//=============================================================================
//  タスクバーにこの子フォームのボタン(アイコン)を表示
//=============================================================================
procedure TSDIChildForm.CreateParams(var Params: TCreateParams);
begin
  inherited;

  if FormStyle in [fsNormal, fsStayOnTop] then begin
    if BorderStyle in [bsSingle, bsSizeable] then begin
      //このフォームの親をDesktopとする
      Params.WndParent := GetDesktopWindow;
    end;
  end;
end;

//=============================================================================
//  メニュー[ファイル][新規]
//  新規にウィンドウを作成
//=============================================================================
procedure TSDIChildForm.menuNewFormClick(Sender: TObject);
begin
  SDIMainForm.CreateChildForm;
end;

//=============================================================================
//  メニュー[ファイル][閉じる]
//=============================================================================
procedure TSDIChildForm.menuCloseClick(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  メニュー[ファイル][全て閉じる]
//  ここでは何もチェックなしで強制終了
//=============================================================================
procedure TSDIChildForm.menuCloseAllClick(Sender: TObject);
begin
  SDIMainForm.Close;
end;

//=============================================================================
//  メニュー[表示][重ねて表示]
//  CascadeWindow関数を使用して，子フォームをカスケード状態に配置して表示
//=============================================================================
procedure TSDIChildForm.menuCascadeWindowClick(Sender: TObject);
const
  MDITILE_ZORDER = 4;
var
  WndList   : array of HWND;
  wnddxdy   : Integer;
  wndRight  : Integer;
  wndBottom : Integer;
  wndRect   : TRect;
  i         : Integer;
begin
  SetLength(WndList, Screen.FormCount);
  for i := 0 to Screen.FormCount - 1 do begin
    WndList[i] := Screen.Forms[i].Handle;
  end;

  wnddxdy   := 25;
  wndRight  := Left + Width + (Screen.FormCount - 1) * wnddxdy;
  wndBottom := Top + Height + (Screen.FormCount - 1) * wnddxdy;
  wndRect := Rect(Left, Top, wndRight, wndBottom);
  CascadeWindows(0, MDITILE_ZORDER, @wndRect, Screen.FormCount, @WndList[0]);
end;

//=============================================================================
//  メニュー[表示][左右に並べて表示]
//  TileWindow関数を使用
//  ただし，ウィンドウの数が多くなると上下左右タイル状に分割表示
//=============================================================================
procedure TSDIChildForm.menuTileVerticalClick(Sender: TObject);
var
  WndList : array of HWND;
  i       : Integer;
begin
  SetLength(WndList, Screen.FormCount);
  for i := 0 to Screen.FormCount - 1 do begin
    WndList[i] := Screen.Forms[i].Handle;
  end;

  TileWindows(0, MDITILE_VERTICAL, nil, Screen.FormCount, @WndList[0]);
  SetForegroundWindow(Handle);
end;

//=============================================================================
//  メニュー[表示][上下に並べて表示]
//  TileWindow関数を使用
//  ただし，ウィンドウの数が多くなると上下左右タイル状に分割表示
//=============================================================================
procedure TSDIChildForm.menuTileHorizontalClick(Sender: TObject);
var
  WndList : array of HWND;
  i       : Integer;
begin
  SetLength(WndList, Screen.FormCount);
  for i := 0 to Screen.FormCount - 1 do begin
    WndList[i] := Screen.Forms[i].Handle;
  end;

  TileWindows(0, MDITILE_HORIZONTAL, nil, Screen.FormCount, @WndList[0]);
  SetForegroundWindow(Handle);
end;

//=============================================================================
//  メニュー[表示][全てを最小化]
//  クラスがこのフォームのクラスと同じものだけを最小化
//=============================================================================
procedure TSDIChildForm.menuMinimizedAllClick(Sender: TObject);
var
  hWindow : THandle;
  i       : Integer;
begin
  for i := 0 to Screen.FormCount - 1 do begin
    hWindow := Screen.Forms[i].Handle;
    if GetClassNameStr(hWindow) = Self.ClassName then begin
      PostMessage(hWindow, WM_SYSCOMMAND, SC_MINIMIZE, 0);
    end;
  end;
end;

//=============================================================================
//  ウィンドウハンドルからウィンドウクラス名を取得
//=============================================================================
function TSDIChildForm.GetClassNameStr(hWindow: HWND): String;
var
  Len    : Integer;
  Buffer : array[0..MAX_PATH-1] of Char;
begin
  FillChar(Buffer, SizeOf(Buffer), #0);
  Len := GetClassName(hWindow, Buffer, Length(Buffer));
  if Len>0 then begin
    SetString(Result, Buffer, Len);
  end else begin
    Result := '';
  end;
end;

end.