unit myMessageBox;

interface
uses
	Windows;

//ベースの関数
function gfniMessageBox(const sWMsg, sWTitle: WideString; const iStyle: UINT): Integer;
{戻り値
IDABORT  [中止]ボタンが選択されました。
IDCANCEL [キャンセル]ボタンが選択されました。
IDIGNORE [無視]ボタンが選択されました。
IDNO     [いいえ]ボタンが選択されました。
IDOK     [OK]ボタンが選択されました。
IDRETRY  [再試行]ボタンが選択されました。
IDYES    [はい]ボタンが選択されました。
}

//ShowMessage
procedure gpcShowMessage(const sWMsg: WideString); overload;
procedure gpcShowMessage(const sWMsg, sWTitle: WideString); overload;

//Application.MessageBox
procedure gpcMessageBox(const sWMsg: WideString); overload;
procedure gpcMessageBox(const sWMsg, sWTitle: WideString); overload;
procedure gpcMessageBox(const sWMsg, sWTitle: WideString; const iStyle: UINT); overload;

//Yes No
function gfniMessageBoxYesNo(const sWMsg: WideString): Integer; overload;
function gfniMessageBoxYesNo(const sWMsg, sWTitle: WideString): Integer; overload;
function gfniMessageBoxYesNo(const sWMsg: WideString; const iStyle: UINT): Integer; overload;
function gfniMessageBoxYesNo(const sWMsg, sWTitle: WideString; const iStyle: UINT): Integer; overload;
//Yes No Cancel
function gfniMessageBoxYesNoCancel(const sWMsg: WideString): Integer; overload;
function gfniMessageBoxYesNoCancel(const sWMsg, sWTitle: WideString): Integer; overload;
function gfniMessageBoxYesNoCancel(const sWMsg, sWTitle: WideString; const iStyle: UINT): Integer; overload;

//書き込みエラーのメッセージ。
procedure gpcWriteErrorMessageBox(const sWMsg: WideString);


function gfnbIsMessageBoxExists(sMsg, sTitle: WideString): Boolean; overload;
function gfnbIsMessageBoxExists: Boolean; overload;

function gfnhMessageBoxHandleGet(sMsg, sTitle: WideString): HWND;

//------------------------------------------------------------------------------
implementation
uses
//	myDebug,
	Classes,
	Forms,
	SysUtils,
	myFile,
	myWindow;


//------------------------------------------------------------------------------
{
MB_OK               [OK]ボタン。
MB_OKCANCEL         [OK]ボタンと[キャンセル]ボタン。
MB_YESNO            [はい]と[いいえ]の2つのボタン。
MB_YESNOCANCEL      [はい]､[いいえ]､[キャンセル]の3つのボタン。
MB_RETRYCANCEL      [再試行]ボタンと[キャンセル]ボタン。
MB_ABORTRETRYIGNORE [中止]､[再試行]､[無視]の3つのボタン。

MB_DEFBUTTON1 最初のボタンがデフォルト。
							MB_DEFBUTTON2､MB_DEFBUTTON3を指定しなければ最初のボタンが常にデフォルト。
MB_DEFBUTTON2 2番目のボタンがデフォルト。
MB_DEFBUTTON3 3番目のボタンがデフォルト。

MB_ICONEXCLAMATION  感嘆符アイコンを表示。
MB_ICONQUESTION     疑問符アイコンを表示。
MB_ICONINFORMATION  円の中に小文字の「i」があるアイコンを表示。
MB_ICONSTOP        「STOP」アイコンを表示。

MB_SYSTEMMODAL
	すべてのアプリケーションはユーザーがメッセージボックスに応答するまで中断されます。
	アプリケーションがMB_ICONHANDを指定しなければメッセージボックスは生成の処理が完
	了するまでにはモーダルになりません。
	このためオーナーウィンドウやそのほかのウィンドウはメッセージボックスのアクティ
	ブ化によるメッセージを受け取り続けます。
	システムモーダルメッセージボックスはすぐに対応を求められるような重大で潜在的な
	危険性のあるエラー(メモリ不足など)をユーザーに通知するために使用してください。
MB_TASKMODAL
	第一引数がnilの時、現在のタスクに属するすべてのトップレベルウィンドウが使用不能
	になることを除いてMB_APPLMODALと同じです。
	呼び出し側のアプリケーションやライブラリが使用可能なウィンドウのハンドルを持た
	ず､ほかのアプリケーションを中断せずに現在のアプリケーションのほかのウィンドウへ
	の入力を阻止しなければならないときには､このフラグを使用してください。
MB_APPLMODAL
	第一引数のウィンドウ内で作業を継続する前に､メッセージボックスに応答しなければな
	りません。
	しかし他のアプリケーションのウィンドウに移動してそのウィンドウ内で作業すること
	はできます。MB_SYSTEMMODAL､MB_TASKMODALを指定しなければMB_APPLMODALがデフォルト
	です。
MB_SETFOREGROUND
	メッセージボックスは前景ウィンドウになります。
MB_DEFAULT_DESKTOP_ONLY
	現在入力を受け取るデスクトップは､ デフォルトのデスクトップでなければなりません。
	それ以外の場合には関数が失敗します。
	デフォルトのデスクトップはユーザーがログオンした後でアプリケーションが動作する
	デスクトップです。

戻り値
IDABORT  [中止]ボタンが選択されました。
IDCANCEL [キャンセル]ボタンが選択されました。
IDIGNORE [無視]ボタンが選択されました。
IDNO     [いいえ]ボタンが選択されました。
IDOK     [OK]ボタンが選択されました。
IDRETRY  [再試行]ボタンが選択されました。
IDYES    [はい]ボタンが選択されました。
}
function gfniMessageBox(const sWMsg, sWTitle: WideString; const iStyle: UINT): Integer;
{2007-10-06,2009-09-25,27:
Unicode対応のMessageBox。
最終的にこの関数が呼ばれる。


2009-09-27:
	Application.MainForm.Handleはメインウィンドウが表示された後でないとアクセス違反
	となるので、その場合はApplication.Handleにするように変更。
2009-09-25:
　MB_SETFOREGROUNDはタスクバーがフラッシュしてしまうのでSetWindowPosを利用して前
　面に表示させるように変更。
}
var
	lh_Window: HWND;
begin
	try
		lh_Window := Screen.ActiveForm.Handle;
	except
		lh_Window := Application.Handle;
	end;

	SetWindowPos(lh_Window, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

	//iStyleに0を指定した場合はMB_OKを指定したのと同じ
	Result := MessageBoxW(Application.Handle, PWideChar(sWMsg), PWideChar(sWTitle), iStyle or MB_APPLMODAL or MB_SETFOREGROUND);
end;



procedure gpcMessageBox(const sWMsg: WideString); overload;
{2008-03-05:
Application.MessageBoxのUnicode版。
}
begin
	gpcMessageBox(sWMsg, gfnsProductNameGet);
end;
procedure gpcMessageBox(const sWMsg, sWTitle: WideString); overload;
{2008-03-05:
Application.MessageBoxのUnicode版。
}
begin
	gfniMessageBox(sWMsg, sWTitle, 0);
end;
procedure gpcMessageBox(const sWMsg, sWTitle: WideString; const iStyle: UINT); overload;
{2008-03-05:
Application.MessageBoxのUnicode版。
}
begin
	gfniMessageBox(sWMsg, sWTitle, iStyle or MB_APPLMODAL or MB_OK);
end;


//ShowMessage
procedure gpcShowMessage(const sWMsg: WideString);
{2007-10-06:
ShowMessageのUnicode版。
}
begin
	gfniMessageBox(sWMsg, gfnsProductNameGet, MB_OK);
end;
procedure gpcShowMessage(const sWMsg, sWTitle: WideString);
{2008-04-04:
ShowMessageのUnicode版。タイトルのキャプション指定付。
}
begin
	gfniMessageBox(sWMsg, sWTitle, MB_OK);
end;


function gfniMessageBoxYesNo(const sWMsg: WideString): Integer;
{2008-03-08:
Unicode対応版のMessageBox。YesとNoボタン。
}
begin
	Result := gfniMessageBoxYesNo(sWMsg, gfnsProductNameGet);
end;

function gfniMessageBoxYesNo(const sWMsg, sWTitle: WideString): Integer;
{2008-03-08:
Unicode対応版のMessageBox。YesとNoボタン。
}
begin
	Result := gfniMessageBoxYesNo(sWMsg, sWTitle, 0);
end;

function gfniMessageBoxYesNo(const sWMsg: WideString; const iStyle: UINT): Integer;
{2007-10-06:
Unicode対応版のMessageBox。YesとNoボタン。
}
begin
	Result := gfniMessageBox(sWMsg, gfnsProductNameGet, iStyle or MB_YESNO or MB_APPLMODAL{ or MB_ICONQUESTION});
end;

function gfniMessageBoxYesNo(const sWMsg, sWTitle: WideString; const iStyle: UINT): Integer;
{2007-10-06:
Unicode対応版のMessageBox。YesとNoボタン。
}
begin
	Result := gfniMessageBox(sWMsg, sWTitle, iStyle or MB_YESNO or MB_APPLMODAL{ or MB_ICONQUESTION});
end;

function gfniMessageBoxYesNoCancel(const sWMsg: WideString): Integer;
{2008-03-08:
Unicode対応版のMessageBox。YesとNoとCancelボタン。
}
begin
	Result := gfniMessageBoxYesNoCancel(sWMsg, gfnsProductNameGet);
end;

function gfniMessageBoxYesNoCancel(const sWMsg, sWTitle: WideString): Integer;
{2008-03-08:
Unicode対応版のMessageBox。YesとNoとCancelボタン。
}
begin
	Result := gfniMessageBoxYesNoCancel(sWMsg, sWTitle, 0);
end;

function gfniMessageBoxYesNoCancel(const sWMsg, sWTitle: WideString; const iStyle: UINT): Integer;
{2008-03-08,06-04:
Unicode対応版のMessageBox。YesとNoとCancelボタン。
2008-06-04:MB_YESNOCANCELでなくMB_YESNOにしていたミスを修正。
}
begin
	Result := gfniMessageBox(sWMsg, sWTitle, iStyle or MB_YESNOCANCEL or MB_APPLMODAL{ or MB_ICONQUESTION});
end;

procedure gpcWriteErrorMessageBox(const sWMsg: WideString);
{2008-01-30:
共有されていなファイルに書き込もうとした時のエラーメッセージ。
}
begin
	gfniMessageBox(WideFormat('%s'#13#13'書き込もうとしたファイルが共有されていないのかも知れません', [sWMsg]), 'エラー', MB_APPLMODAL or MB_OK);
end;


function gfnbIsMessageBoxExists(sMsg, sTitle: WideString): Boolean;
{2009-03-06:
アプリで既にメッセージボックスを出していたらTrueを返す
}
	function EnumWindowsProc(hHandle: HWND; pList: TList): BOOL; stdcall;
	const
		lcsMESSAGEBOX_CLASSNAME = '#32770';
		lci_MESSAGEBOX_RESULT  = 0;
		lci_MESSAGEBOX_MSGTEXT = 1;
		lci_MESSAGEBOX_TITLE   = 2;
	begin
		Result := True;
		if  (gfnhOwnerWindowGet(hHandle) = Application.Handle)
		and (gfnsClassNameGet(hHandle)   = lcsMESSAGEBOX_CLASSNAME)
		then begin
			//メッセージボックスがあった
			if ((WideString(pList[lci_MESSAGEBOX_MSGTEXT]^) =  #0) and (WideString(pList[lci_MESSAGEBOX_TITLE]^) = #0))
			or ((WideString(pList[lci_MESSAGEBOX_TITLE]^)   <> #0) and (WideString(pList[lci_MESSAGEBOX_TITLE]^) = gfnsWindowTextGet(hHandle)))
			or ((WideString(pList[lci_MESSAGEBOX_MSGTEXT]^) <> #0) and (FindWindowExW(hHandle, 0, 'STATIC', PWideChar(WideString(pList[lci_MESSAGEBOX_MSGTEXT]^))) <> 0))
			then begin
				Result := False;
				Boolean(pList[lci_MESSAGEBOX_RESULT]^) := True;
			end;
		end;
	end;
var
	lsl_List: TList;
begin
	Result := False;
	lsl_List := TList.Create;
	try
		lsl_List.Add(@Result);
		lsl_List.Add(@sMsg);
		lsl_List.Add(@sTitle);
		EnumWindows(@EnumWindowsProc, Integer(lsl_List));
	finally
		lsl_List.Clear;
		lsl_List.Free;
	end;
end;
function gfnbIsMessageBoxExists: Boolean;
{2009-03-06:
アプリで既にメッセージボックスを出していたらTrueを返す。
}
begin
	Result := gfnbIsMessageBoxExists(#0, #0);
end;

function gfnhMessageBoxHandleGet(sMsg, sTitle: WideString): HWND;
{2009-03-30:
アプリのメッセージボックスのウィンドウハンドルを返す。
}
	function EnumWindowsProc(hHandle: HWND; pList: TList): BOOL; stdcall;
	const
		lcsMESSAGEBOX_CLASSNAME = '#32770';
		lci_MESSAGEBOX_RESULT  = 0;
		lci_MESSAGEBOX_MSGTEXT = 1;
		lci_MESSAGEBOX_TITLE   = 2;
	begin
		Result := True;
		if  (gfnhOwnerWindowGet(hHandle) = Application.Handle)
		and (gfnsClassNameGet(hHandle)   = lcsMESSAGEBOX_CLASSNAME)
		then begin
			//メッセージボックスがあった
			if ((WideString(pList[lci_MESSAGEBOX_MSGTEXT]^) =  #0) and (WideString(pList[lci_MESSAGEBOX_TITLE]^) = #0))
			or ((WideString(pList[lci_MESSAGEBOX_TITLE]^)   <> #0) and (WideString(pList[lci_MESSAGEBOX_TITLE]^) = gfnsWindowTextGet(hHandle)))
			or ((WideString(pList[lci_MESSAGEBOX_MSGTEXT]^) <> #0) and (FindWindowExW(hHandle, 0, 'STATIC', PWideChar(WideString(pList[lci_MESSAGEBOX_MSGTEXT]^))) <> 0))
			then begin
				Result := False;
				HWND(pList[lci_MESSAGEBOX_RESULT]^) := hHandle;
			end;
		end;
	end;
var
	lsl_List: TList;
begin
	Result   := 0;
	lsl_List := TList.Create;
	try
		lsl_List.Add(@Result);
		lsl_List.Add(@sMsg);
		lsl_List.Add(@sTitle);
		EnumWindows(@EnumWindowsProc, Integer(lsl_List));
	finally
		lsl_List.Clear;
		lsl_List.Free;
	end;
end;


end.