source: trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/TaskMsg.ab@ 561

'Classes/ActiveBasic/Windows/UI/TaskDialog.ab

Namespace ActiveBasic
Namespace Windows
Namespace UI
Namespace Detail

/*!
@brief TaskMsgの実装担当。
@date 2008/06/27
@auther Egtra
*/
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
    'TaskDialog関数で表示できないもの (Case Else) をエラーにするため、
    'TaskDialogを使わない場合でもこのSelectを通るようにしている。
    Dim buttonFlags As TASKDIALOG_COMMON_BUTTON_FLAGS
    Select Case mbType
        Case MB_YESNOCANCEL
            buttonFlags = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON Or TDCBF_CANCEL_BUTTON
        Case MB_YESNO
            buttonFlags = TDCBF_YES_BUTTON Or TDCBF_NO_BUTTON
        Case MB_RETRYCANCEL
            buttonFlags = TDCBF_RETRY_BUTTON Or TDCBF_CANCEL_BUTTON
        Case MB_OKCANCEL
            buttonFlags = TDCBF_OK_BUTTON Or TDCBF_CANCEL_BUTTON
        Case MB_OK
            buttonFlags = TDCBF_OK_BUTTON
        Case Else
            ShowTaskDialog = E_INVALIDARG
            Exit Function
    End Select
    '同様の理由でアイコンのフラグも確認する。
    Dim icon As PCWSTR
    Select Case mbIcon
        Case MB_ICONEXCLAMATION
            icon = TD_WARNING_ICON
        Case 0, MB_ICONQUESTION
            icon = 0
        Case MB_ICONHAND
            icon = TD_ERROR_ICON
        Case MB_ICONASTERISK
            icon = TD_INFORMATION_ICON
        Case Else
            ShowTaskDialog = E_INVALIDARG
            Exit Function
    End Select

    If IsNothing(title) Then
        title = "" 'TaskDialogとMessageBoxで表示内容が異なるので統一
    End If

    Dim hmodComCtl = GetModuleHandle("comctl32.dll")
    If hmodComCtl <> 0 Then
        Dim pTaskDialog = GetProcAddress(hmodComCtl, ToMBStr("TaskDialog")) As PTaskDialog
        If pTaskDialog <> 0 Then
            ShowTaskDialog = pTaskDialog(hwndOwner, 0, ToWCStr(title), ToWCStr(instruction), ToWCStr(comment), buttonFlags, icon, VarPtr(button))
            If SUCCEEDED(ShowTaskDialog) Then
                Exit Function
            End If
            'だめだったら、MessageBoxを試みる。
        End If
    End If

    Dim msg = instruction
    If Not String.IsNullOrEmpty(comment) Then
        msg += Ex"\r\n\r\n" + comment
    End If
    Dim b = MessageBox(hwndOwner, StrPtr(msg), StrPtr(title), mbType Or mbIcon)
    If b = 0 Then
        ShowTaskDialog = HRESULT_FROM_WIN32(GetLastError())
    Else
        button = b
        ShowTaskDialog = S_OK
    End If
End Function

TypeDef PTaskDialog = *Function( _
    hwnd As HWND,
    hinst As HINSTANCE,
    pszWindowTitle As PCWSTR,
    pszMainInstruction As PCWSTR,
    pszComment As PCWSTR,
    dwCommonButtons As TASKDIALOG_COMMON_BUTTON_FLAGS,
    pszIcon As PCWSTR,
    ByVal pnButton As *Long
) As HRESULT

End Namespace 'Detail

/*!
@brief TaskDialogが使えるときはそれを、ないときにはMessageBoxを表示する。
@param[in] hwndOwner オーナーウィンドウ（無ければNULL）。
@param[in] title タイトル（Nothingでも良いがそのときの表示内容は未定）。
@param[in] instruction メッセージ内容となるテキスト。
@param[in] comment 補足説明となるテキスト（Nothingでも良い）。
@param[in] mbType 選択肢の指定、MB_YESNOCANCEL, MB_YESNO, MB_RETRYCANCEL, MB_OKCANCEL, MB_OKに対応。
@param[in] mbIcon アイコン、0（なし）, MB_ICONEXCLAMATION, MB_ICONHAND, MB_ICONASTERISKに対応。MB_ICONQUESTIONも指定可能だが無視される（0と同じ）。
@return ユーザの押したものに応じてIDCANCEL, IDNO, IDOK, IDRETRY, IDYESのいずれか。
@throw 何かエラーが起こったらException（またはその派生）が投げられる。
@date 2008/07/21
@auther Egtra
*/
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
    Dim hr = Detail.ShowTaskDialog(hwndOwner, title, instruction, comment, mbType, mbIcon, TaskMsg)
    ThrowIfFailed(hr)
End Function

End Namespace 'UI
End Namespace 'Widnows
End Namespace 'ActiveBasic