طریقه فارسی نوشتن msgBox

[m_bargostavan_66]

چطوری میشه کلیدهای یک msgBox را هم فارسی کرد مثل عکس زیر

[karmand]

خودت فرم و باتن درست كن و ان را در يك زير برنامه با پارامتر شبيه به فرم اصلي و هر وقت خواستي ان را صدا كن

[smderfan]

سلام
شما براي اينكار بايد از ماژول زير استفاده كنيد.

Option Compare Database

Option Explicit

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

'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type

'need this declared at module level as
'it is used in the call and the hook proc
Private MSGHOOK As MSGBOX_HOOK_PARAMS

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Public Declare Function GetDesktopWindow Lib "user32" () 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

Public Function MsgBoxFa(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Tiltle = "", Optional HelpFile, Optional Context) As Long

'Wrapper function for the MessageBox API
Dim hwndThreadOwner As Long
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm

hwndThreadOwner = frmCurrentForm.hWnd

Dim hInstance As Long

Dim hThreadId As Long
Dim hwndOwner As Long
hwndOwner = GetDesktopWindow()
hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()

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



MsgBoxFa = MessageBox(hwndThreadOwner, Prompt, Tiltle, Buttons)

End Function


Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

If uMsg = HCBT_ACTIVATE Then

SetDlgItemText wParam, vbYes, "بلي"
SetDlgItemText wParam, vbNo, "خير"
SetDlgItemText wParam, vbIgnore, "لغو"
SetDlgItemText wParam, vbOK, "تأييد"

UnhookWindowsHookEx MSGHOOK.hHook

End If

MsgBoxHookProc = False

End Function


جهت فراخواني بصورت زير عمل كنيد :


Responce = MsgBoxFa("متن پيام", vbOKOnly + vbCritical, "توجه")