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 (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.
複数のフォームを扱うアプリには,MDI (Multiple Document Interface) アプリもあります.
MDI アプリは,下図のように,フォーム内に,複数のフォームを表示するものです.
このサンプルは,これの簡単な例です. |
|
図5
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.
//=============================================================================
// 子フォームを閉じる時は,解放
//
// この子フォームのFormStyleはfsMDIChildにしている
// また,[自動生成]のチェックを外し,実行時生成にしている
//=============================================================================
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
Delphi の新規作成用のテンプレートに MDI アプリケーションがあります.
[ファイル] [新規作成] [その他] で選択できます.下の図は,実際にプロジェクトを作成して実行した結果です. |
|
図6
MDI アプリケーションのテンプレート |
作成した 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.
子フォームでの処理は,ほとんどがメニューを選択した時の処理です.
この子フォームのボタン (アイコン) をタスクバーに表示するために,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.
|