1 | 'Classes/ActiveBasic/Windows/UI/TaskDialog.ab
|
---|
2 |
|
---|
3 | Namespace ActiveBasic
|
---|
4 | Namespace Windows
|
---|
5 | Namespace UI
|
---|
6 | Namespace Detail
|
---|
7 |
|
---|
8 | /*!
|
---|
9 | @brief TaskMsgの実装担当。
|
---|
10 | @date 2008/06/27
|
---|
11 | @auther Egtra
|
---|
12 | */
|
---|
13 | Function ShowTaskDialog(hwndOwner As HWND, title As String, instruction As String, comment As String, mbType As DWord, mbIcon As DWord, ByRef button As Long) As HRESULT
|
---|
14 | 'TaskDialog関数で表示できないもの (Case Else) をエラーにするため、
|
---|
15 | 'TaskDialogを使わない場合でもこのSelectを通るようにしている。
|
---|
16 | Dim buttonFlags As TASKDIALOG_COMMON_BUTTON_FLAGS
|
---|
17 | Select Case mbType
|
---|
18 | Case MB_YESNOCANCEL
|
---|
19 | buttonFlags = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON Or TDCBF_CANCEL_BUTTON
|
---|
20 | Case MB_YESNO
|
---|
21 | buttonFlags = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON
|
---|
22 | Case MB_RETRYCANCEL
|
---|
23 | buttonFlags = TDCBF_RETRY_BUTTON Or TDCBF_CANCEL_BUTTON
|
---|
24 | Case MB_OKCANCEL
|
---|
25 | buttonFlags = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON
|
---|
26 | Case MB_OK
|
---|
27 | buttonFlags = TDCBF_OK_BUTTON
|
---|
28 | Case Else
|
---|
29 | ShowTaskDialog = E_INVALIDARG
|
---|
30 | Exit Function
|
---|
31 | End Select
|
---|
32 | '同様の理由でアイコンのフラグも確認する。
|
---|
33 | Dim icon As PCWSTR
|
---|
34 | Select Case mbIcon
|
---|
35 | Case MB_ICONEXCLAMATION
|
---|
36 | icon = TD_WARNING_ICON
|
---|
37 | Case 0, MB_ICONQUESTION
|
---|
38 | icon = 0
|
---|
39 | Case MB_ICONHAND
|
---|
40 | icon = TD_ERROR_ICON
|
---|
41 | Case MB_ICONASTERISK
|
---|
42 | icon = TD_INFORMATION_ICON
|
---|
43 | Case Else
|
---|
44 | ShowTaskDialog = E_INVALIDARG
|
---|
45 | Exit Function
|
---|
46 | End Select
|
---|
47 |
|
---|
48 | If IsNothing(title) Then
|
---|
49 | title = "" 'TaskDialogとMessageBoxで表示内容が異なるので統一
|
---|
50 | End If
|
---|
51 |
|
---|
52 | Dim hmodComCtl = GetModuleHandle("comctl32.dll")
|
---|
53 | If hmodComCtl <> 0 Then
|
---|
54 | Dim pTaskDialog = GetProcAddress(hmodComCtl, ToMBStr("TaskDialog")) As PTaskDialog
|
---|
55 | If pTaskDialog <> 0 Then
|
---|
56 | ShowTaskDialog = pTaskDialog(hwndOwner, 0, ToWCStr(title), ToWCStr(instruction), ToWCStr(comment), buttonFlags, icon, VarPtr(button))
|
---|
57 | If SUCCEEDED(ShowTaskDialog) Then
|
---|
58 | Exit Function
|
---|
59 | End If
|
---|
60 | 'だめだったら、MessageBoxを試みる。
|
---|
61 | End If
|
---|
62 | End If
|
---|
63 |
|
---|
64 | Dim msg = instruction
|
---|
65 | If Not String.IsNullOrEmpty(comment) Then
|
---|
66 | msg += Ex"\r\n\r\n" + comment
|
---|
67 | End If
|
---|
68 | Dim b = MessageBox(hwndOwner, StrPtr(msg), StrPtr(title), mbType Or mbIcon)
|
---|
69 | If b = 0 Then
|
---|
70 | ShowTaskDialog = HRESULT_FROM_WIN32(GetLastError())
|
---|
71 | Else
|
---|
72 | button = b
|
---|
73 | ShowTaskDialog = S_OK
|
---|
74 | End If
|
---|
75 | End Function
|
---|
76 |
|
---|
77 | TypeDef PTaskDialog = *Function( _
|
---|
78 | hwnd As HWND,
|
---|
79 | hinst As HINSTANCE,
|
---|
80 | pszWindowTitle As PCWSTR,
|
---|
81 | pszMainInstruction As PCWSTR,
|
---|
82 | pszComment As PCWSTR,
|
---|
83 | dwCommonButtons As TASKDIALOG_COMMON_BUTTON_FLAGS,
|
---|
84 | pszIcon As PCWSTR,
|
---|
85 | ByVal pnButton As *Long
|
---|
86 | ) As HRESULT
|
---|
87 |
|
---|
88 | End Namespace 'Detail
|
---|
89 |
|
---|
90 | /*!
|
---|
91 | @brief TaskDialogが使えるときはそれを、ないときにはMessageBoxを表示する。
|
---|
92 | @param[in] hwndOwner オーナーウィンドウ(無ければNULL)。
|
---|
93 | @param[in] title タイトル(Nothingでも良いがそのときの表示内容は未定)。
|
---|
94 | @param[in] instruction メッセージ内容となるテキスト。
|
---|
95 | @param[in] comment 補足説明となるテキスト(Nothingでも良い)。
|
---|
96 | @param[in] mbType 選択肢の指定、MB_YESNOCANCEL, MB_YESNO, MB_RETRYCANCEL, MB_OKCANCEL, MB_OKに対応。
|
---|
97 | @param[in] mbIcon アイコン、0(なし), MB_ICONEXCLAMATION, MB_ICONHAND, MB_ICONASTERISKに対応。MB_ICONQUESTIONも指定可能だが無視される(0と同じ)。
|
---|
98 | @return ユーザの押したものに応じてIDCANCEL, IDNO, IDOK, IDRETRY, IDYESのいずれか。
|
---|
99 | @throw 何かエラーが起こったらException(またはその派生)が投げられる。
|
---|
100 | @date 2008/07/21
|
---|
101 | @auther Egtra
|
---|
102 | */
|
---|
103 | Function TaskMsg(hwndOwner As HWND, title As String, instruction As String, comment = Nothing As String, mbType = MB_OK As DWord, mbIcon = 0 As DWord) As Long
|
---|
104 | Dim hr = Detail.ShowTaskDialog(hwndOwner, title, instruction, comment, mbType, mbIcon, TaskMsg)
|
---|
105 | ThrowIfFailed(hr)
|
---|
106 | End Function
|
---|
107 |
|
---|
108 | End Namespace 'UI
|
---|
109 | End Namespace 'Widnows
|
---|
110 | End Namespace 'ActiveBasic
|
---|