[561] | 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
|
---|