VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板

　　　　　サンプル投稿用掲示板　　 VB2005 ～用トップページ　　 VB6.0 用トップページ

ボタンのキャプションを変えられるメッセージボックス(VB6.0)_1 ( No.1 ) 　[親スレッドへ]

日時： 2009/12/28 10:09
名前： 花ちゃん: ***********************************************************************************
* カテゴリー：[メッセージ][][]                                                    *
* キーワード：MsgBox,ボタンのテキストを変更,ボタンのキャプションを変更            *
***********************************************************************************
タイトル： MsgBoxのボタンの文字変更
記事 No ： 13182
投稿日： 2008/10/24(Fri) 17:28
元質問者： AIKO

MsgBoxのボタンに表示される文字を任意に変更できないものでしょうか？
例えばvbYesNoCancelの場合、[はい]、[いいえ]、[キャンセル] の3種類ですが
それぞれ[拝承]、[拒絶]、[戻る] などに変更。

-----------------------------------------------------------------------------------
記事No ： 13185
投稿日： 2008/10/25(Sat) 11:28
回答者： YK
-----------------------------------------------------------------------------------

標準モジュールに
Option Explicit
Private Declare Function FindWindowEx Lib "user32" _
                            Alias "FindWindowExA" _
                           (ByVal hWnd1 As Long, _
                            ByVal hWnd2 As Long, _
                            ByVal lpsz1 As String, _
                            ByVal lpsz2 As String) As Long

Private Declare Function GetParent Lib "user32" _
                           (ByVal Hwnd As Long) As Long

Private Declare Sub SetWindowText Lib "user32" _
                            Alias "SetWindowTextA" _
                           (ByVal Hwnd As Long, _
                            ByVal lpString As String)

Private Declare Function SetTimer Lib "user32" _
                           (ByVal Hwnd As Long, _
                            ByVal nIDEvent As Long, _
                            ByVal uElapse As Long, _
                            ByVal lpTimerFunc As Long) As Long

Private Declare Sub KillTimer Lib "user32" _
                           (ByVal Hwnd As Long, _
                            ByVal nIDEvent As Long)
Public LngID  As Long
Public mTitle As String
Public mItem1 As String
Public mItem2 As String
Public mItem3 As String

Public Sub TimerProc(ByVal Hwnd As Long, ByVal uMsg As Long, _
              ByVal idEvent As Long, ByVal dwTime As Long)
    Dim dlghWnd     As Long
    Dim btn1hWnd As Long
    Dim btn2hWnd As Long
    Dim btn3hWnd As Long

    On Error Resume Next
    dlghWnd = FindWindowEx(0&, 0&, "#32770", mTitle)
    If GetParent(dlghWnd) <> Form1.Hwnd Then Exit Sub

    btn1hWnd = FindWindowEx(dlghWnd, 0&, "Button", "はい(&Y)")
    If btn1hWnd <> 0& Then SetWindowText btn1hWnd, mItem1

    btn2hWnd = FindWindowEx(dlghWnd, 0&, "Button", "いいえ(&N)")
    If btn2hWnd <> 0& Then SetWindowText btn2hWnd, mItem2

    btn3hWnd = FindWindowEx(dlghWnd, 0&, "Button", "キャンセル")
    If btn3hWnd <> 0& Then SetWindowText btn3hWnd, mItem3

    Timer_End
End Sub

Public Sub Timer_Start()
    If LngID = 0 Then
        LngID = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
    End If
End Sub

Public Sub Timer_End()
    If LngID <> 0 Then
        KillTimer 0&, LngID
        LngID = 0
    End If
End Sub

フォームモジュールに
Private Sub Command1_Click()
    Dim lngRtn  As VbMsgBoxResult
    mTitle = "Msgbox Test"
    mItem1 = "拝承"
    mItem2 = "拒絶"
    mItem3 = "戻る"
    Timer_Start
    lngRtn = MsgBox("ボタンテキストのテスト", vbYesNoCancel, mTitle)
    Timer_End
    Select Case lngRtn
        Case vbYes
            MsgBox mItem1 & " がクリックされました。"
        Case vbNo
            MsgBox mItem2 & " がクリックされました。"
        Case vbCancel
            MsgBox mItem3 & " がクリックされました。"
        Case Else
            MsgBox "クリックされました。"
    End Select
End Sub