Hossis
سه شنبه 06 بهمن 1388, 14:29 عصر
این کد در vb6 خوب عمل می کند ولی من در دات نت به اون نیاز دارم
در صورت امکان، آن را تبدیل به دات نت کنید
به هیج نحوی نتونستم اون رو تبدیل کنم چون در یک خط ، خطا می دهد:عصبانی++:
خیلی ضروری و لازمه به طوری که حاضرم هزینه و کارمزد تبدیل اون رو هم بپردازم:گریه:
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 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 MsgFox(پنجره As Form, متن_پیام As String, Optional رمز_پیام As VbMsgBoxStyle, Optional عنوان_پیام As String) As Long
MessageBoxH پنجره.hWnd
If IsMissing(رمز_پیام) Then رمز_پیام = vbOKOnly
If IsMissing(عنوان_پیام) Then عنوان_پیام = پنجره.Caption
If IsMissing(نوع_پیام) Then دکمه_پیام = vbOKOnly, Optional نوع_پیام As Long
MsgFox = MsgBox(متن_پیام, رمز_پیام + vbMsgBoxRtlReading + vbMsgBoxRight, عنوان_پیام)
End Function
در صورت امکان، آن را تبدیل به دات نت کنید
به هیج نحوی نتونستم اون رو تبدیل کنم چون در یک خط ، خطا می دهد:عصبانی++:
خیلی ضروری و لازمه به طوری که حاضرم هزینه و کارمزد تبدیل اون رو هم بپردازم:گریه:
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 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 MsgFox(پنجره As Form, متن_پیام As String, Optional رمز_پیام As VbMsgBoxStyle, Optional عنوان_پیام As String) As Long
MessageBoxH پنجره.hWnd
If IsMissing(رمز_پیام) Then رمز_پیام = vbOKOnly
If IsMissing(عنوان_پیام) Then عنوان_پیام = پنجره.Caption
If IsMissing(نوع_پیام) Then دکمه_پیام = vbOKOnly, Optional نوع_پیام As Long
MsgFox = MsgBox(متن_پیام, رمز_پیام + vbMsgBoxRtlReading + vbMsgBoxRight, عنوان_پیام)
End Function