ساخت MsgBox دلخواه با VB 6 - نسخه قابل چاپ

کد:
Option Explicit

Private m_hHook As Long



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



Private Const WH_CBT = 5

Private Const GWL_HINSTANCE = (-6)

Private Const HCBT_ACTIVATE = 5



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 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long





Public Sub MessageBoxH(hwndThreadOwner As Long)



Dim hInstance As Long

Dim hThreadId As Long



hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)

hThreadId = GetCurrentThreadId()



m_hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)



End Sub



Private Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long



If uMsg = HCBT_ACTIVATE Then

SetDlgItemText wParam, IDOK, "ÊÃííÏ"

SetDlgItemText wParam, IDCANCEL, "áÛæ"

SetDlgItemText wParam, IDABORT, "ÞØÚ Úãá"

SetDlgItemText wParam, IDRETRY, "ÓÚí ãÌÏÏ"

SetDlgItemText wParam, IDIGNORE, "ÕÑÝ äÙÑ"

SetDlgItemText wParam, IDYES, "Èáå"

SetDlgItemText wParam, IDNO, "ÎíÑ"



UnhookWindowsHookEx m_hHook

End If

MsgBoxHookProc = False



End Function



Public Function MsgBox2(Form1 As Form, prompt As String, style As VbMsgBoxStyle, title As String) As Long

MessageBoxH Form1.hwnd

MsgBox2 = MsgBox(prompt, style, title)

End Function



Public Function MsgBox3(Form1 As Form, prompt As String, style As VbMsgBoxStyle, title As String) As Long

MessageBoxH Form1.hwnd

MsgBox3 = MsgBox(prompt, style + vbMsgBoxRtlReading + vbMsgBoxRight, title)

End Function