Coding4ever’s Blog

Just coding… coding… and coding… because coding should be fun :)

Custom MsgBox Function

| Comments

Fungsi MsgBox digunakan untuk menampilkan pesan/informasi kepada user dan fungsi MsgBox sendiri mempunyai beberapa style yang mana style ini berpengaruh terhadap pilihan tombol yang ditampilkan.

Kita ambil contoh beberapa style yang sering digunakan, lihat gambar :

Kemudian kita akan mencoba mengganti pesan YesNo -> YaTidak dan OkCancel -> OkBatal :

Penasaran dengan kodenya seperti apa, langsung saja tambahkan sebuah modul kemudian copy paste kode berikut :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Explicit

Public Const IDOK = 1
Public Const IDCANCEL = 2
Public Const IDYES = 6
Public Const IDNO = 7

Private Const IDPROMPT = &HFFFF&

Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5

Private Type MSGBOX_HOOK_PARAMS
    hwndOwner   As Long
    hHook       As Long
End Type

Private MSGHOOK As MSGBOX_HOOK_PARAMS

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = HCBT_ACTIVATE Then
        SetWindowText wParam, "Konfirmasi"

        SetDlgItemText wParam, IDYES, "Ya"
        SetDlgItemText wParam, IDNO, "Tidak"

        SetDlgItemText wParam, IDOK, "Oke"
        SetDlgItemText wParam, IDCANCEL, "Batal"

        SetDlgItemText wParam, IDPROMPT, "Apakah Anda ingin keluar ?"

        UnhookWindowsHookEx MSGHOOK.hHook
    End If

    MsgBoxHookProc = False
End Function

Public Function MessageBoxH(ByVal hwndThreadOwner As Long, ByVal hwndOwner As Long, ByVal button As VbMsgBoxStyle) As Long
   Dim hInstance As Long
   Dim hThreadId As Long

   hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
   hThreadId = GetCurrentThreadId()

   With MSGHOOK
      .hwndOwner = hwndOwner
      .hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)
   End With

   MessageBoxH = MessageBox(hwndOwner, Space$(40), Space$(40), vbQuestion + button)
End Function

Untuk contoh penggunaan tambahkan objek CommandButton, kemudian ketik kode berikut :

1
2
3
4
5
6
7
8
Private Sub cmdDemoCustomeMsgBox_Click()
    Select Case MessageBoxH(Me.hwnd, Me.hwnd, vbOKCancel)
        Case IDYES: Debug.Print "Anda mengklik tombol Ya"
        Case IDNO: Debug.Print "Anda mengklik tombol Tidak"
        Case IDOK: Debug.Print "Anda mengklik tombol Oke"
        Case IDCANCEL: Debug.Print "Anda mengklik tombol Batal"
    End Select
End Sub

Referensi : http://vbnet.mvps.org

Selamat mencoba :)

Comments