-
Notifications
You must be signed in to change notification settings - Fork 1
/
mdl_MSG.bas
160 lines (142 loc) · 5.35 KB
/
mdl_MSG.bas
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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Option Explicit
'=======================================================
' Module for Vietnamized MsgBox function
' This overide default VBA MsgBox function with some small
' modifications of text, button caption....
' Use this MsgBox function like it is in default VBA IDE
'=======================================================
' Import
#If VBA7 Then
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
Private Declare PtrSafe Function SetDlgItemText Lib "user32" _
Alias "SetDlgItemTextW" _
(ByVal hDlg As LongPtr, _
ByVal nIDDlgItem As LongPtr, _
ByVal lpString As String) As LongPtr
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As LongPtr, _
ByVal lpfn As LongPtr, _
ByVal hmod As LongPtr, _
ByVal dwThreadId As LongPtr) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As LongPtr) As LongPtr
' Handle to the Hook procedure
Private hHook As LongPtr
#Else
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function SetDlgItemText Lib "user32" _
Alias "SetDlgItemTextW" _
(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 UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
' Handle to the Hook procedure
Private hHook As Long
#End If
' Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
' Constants
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
' Modify this code for English
Private StrYes As String
Private StrNo As String
Private StrOK As String
Private StrCancel As String
Private StrRetry As String
Private StrIgnore As String
Private StrAbort As String
Private Enum MsoAlertCancelType
msoAlertCancelDefault = &HFFFFFFFF
msoAlertCancelFifth = 4
msoAlertCancelFirst = 0
msoAlertCancelFourth = 3
msoAlertCancelSecond = 1
msoAlertCancelThird = 2
End Enum
' Application title
Private App_Title As String
Function MsgBox(MessageTxt As String, Optional msgStyle As VbMsgBoxStyle, Optional DlgCaption As String = "") As VbMsgBoxResult
Beep
If App_Title = "" Then App_Title = MSG("APP_TITLE")
Dim msgBoxIcon As Long, msgButton As Long, btnStyle As Long, ErrLoop As Boolean
Dim ButtonDefault As Long
' Determine what button is default....
Dim btnArr As Variant, i As Long
btnArr = Array(0, 256, 512, 768)
For i = 0 To UBound(btnArr)
btnStyle = msgStyle - btnArr(i)
If btnStyle < 0 Then
ButtonDefault = i - 1
btnStyle = msgStyle - btnArr(i - 1)
ErrLoop = True
Exit For
End If
Next
' Determine Icon...
btnArr = Array(0, 16, 32, 48, 64)
For i = 0 To UBound(btnArr)
msgButton = btnStyle - btnArr(i)
If msgButton <= 0 Then
If msgButton = 0 Then
msgBoxIcon = i
btnStyle = btnStyle - btnArr(i)
Else
msgBoxIcon = i - 1
btnStyle = btnStyle - btnArr(i - 1)
End If
ErrLoop = True
Exit For
End If
Next
If ErrLoop Then
' get the button style
If msgButton < 0 Then msgButton = btnStyle
' clear error if number of button is smaller than the default setting...
If ButtonDefault > msgButton Then ButtonDefault = msgButton
Else
ButtonDefault = 0
msgButton = 0
msgBoxIcon = 0
End If
' Set Hook
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
' Display the messagebox
MsgBox = Application.Assistant.DoAlert(IIf(DlgCaption <> "", DlgCaption, App_Title), _
MessageTxt, msgButton, msgBoxIcon, ButtonDefault, msoAlertCancelDefault, True)
End Function
Private Function MsgBoxHookProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
StrYes = "&C" & ChrW(243)
StrNo = "&Kh" & ChrW(244) & "ng"
StrOK = "Ch" & ChrW(7845) & "p nh" & ChrW(7853) & "&n"
StrCancel = "&H" & ChrW(7911) & "y"
StrRetry = "&Th" & ChrW(7917) & " l" & ChrW(7841) & "i"
StrAbort = "&D" & ChrW(7915) & "ng"
StrIgnore = "&B" & ChrW(7887) & " qua"
SetDlgItemText wParam, IDYES, StrConv(StrYes, vbUnicode)
SetDlgItemText wParam, IDNO, StrConv(StrNo, vbUnicode)
SetDlgItemText wParam, IDCANCEL, StrConv(StrCancel, vbUnicode)
SetDlgItemText wParam, IDOK, StrConv(StrOK, vbUnicode)
SetDlgItemText wParam, IDABORT, StrConv(StrAbort, vbUnicode)
SetDlgItemText wParam, IDRETRY, StrConv(StrRetry, vbUnicode)
SetDlgItemText wParam, IDIGNORE, StrConv(StrIgnore, vbUnicode)
' Release the Hook
UnhookWindowsHookEx hHook
End If
MsgBoxHookProc = False
End Function