روش انتقال متن فارسی به دکمه های اجرایی موجود در Msgbox

اگر کسی کدی داره درباره این موضوع در نظرات کپی کنه تا دیگران هم استفاده کنند برای اینکار از توابع Windows استفاده شده و روش Hook کردن پنجره Msgbox و ارسال پیغام با SendMessageA است.برای ویندوز 32 بیت و 64 روش اظهار تابع فرق میکند.

اگر در نظر سنجی شرکت کنید و موافقت خودتون را در نظرات اعلام کنید به زودی کد خط به خط در اینجا از سایت های خارجی استخراج ودر معرض عموم قرار خواهد گرفت.

MsgBox ( prompt [, buttons ] [, title ] [, helpfile ] [, context ] 

Hooks-Win32 application

SetWindowsHookEx :
Installs an application-defined hook procedure into a hook chain. You would install a hook procedure to monitor the system for certain types of events. These events are associated either with a specific thread or with all threads in the same desktop as the calling thread

UnhookWindowsHookEx :
Removes a hook procedure installed in a hook chain by the SetWindowsHookEx function

CallNextHookEx :
Passes the hook information to the next hook procedure in the current hook chain. A hook procedure can call this function either before or after processing the hook information.

CallWndProc :
An application-defined or library-defined callback function used with the SetWindowsHookEx function. The system calls this function before calling the window procedure to process a message sent to the thread

winuser-messageboxa

IDOK1
IDCANCEL2
IDYES6
IDNO7

winuser-hookproc

Hookproc(nCode,wparam,lparam)

CbtProc https://

getcurrentthreadid

setdlgitemtexta

با تابع بالا پیغامی را به پنجره دیالوگ باکس میدهید که Title یا تکست کنترل مورد نظر تنظیم شود 

در ویندوز 64 بیت نحوه اظهار کردن یک PtrSafe قبل از Function آمده و در بعضی از آرگومانها بجای تایپ Long از LongPtr استفاده شده.

#If VBA7 Then

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

Private Declare PtrSafe Function SetDlgItemTextA Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long

Private Declare PtrSafe Function SetWindowsHookExA Lib "user32" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr 

Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long

Private Declare PtrSafe Function MessageBoxL Lib "user32" Alias "MessageBoxW" ( _
  ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, _
  ByVal wType As Long) As Long
Private

End If

'Declaration API functions of User32.DLL. for Office 32 or 64-bit

#If VBA7 Then

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#Else
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long #End If 

توابع ویندوزی برای مسیج باکس : 

lpText

The message to be displayed. If the string consists of more than one line, you can separate the lines using a carriage return and/or linefeed character between each line.

lpCaption

The dialog box title. If this parameter is NULL, the default title is Error.

#If VBA7 Then
Private Declare PtrSafe Function MessageBoxA Lib "user32" ( _ ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#Else
Private Declare Function MessageBoxA Lib "user32" ( _ ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long #End If

wType
To indicate the buttons displayed in the message box, specify one of the following

برای مشخص کردن اینکه کدام باتن ها در پنجره Message Box نشان داده شوند  از اعداد هگزاگون رزور شده استفاده می کنیم که هر کدام معرف باتنی است.

MB_OK=&H0
MB_OKCANCEL=&H1
MB_YESNO=&H4
MB_YESNOCANCEL=3

To display an icon in the message box, specify one of the following values.

برای مشخص کردن آیکونی در این پنجره یکی از مقادیر زیر راانتخاب میکنیم 

MB_ICONEXCLAMATION=&H30

MB_ICONINFORMATION=&H40

MB_ICONQUESTION=&H20

MB_ICONSTOP=&H10

To indicate the default button, specify one of the following values.

 برای مشخص کردن اینکه کدام باتن در این پنجره فوکس گرفته باشد یا دیفالت باشد از مقادیر زیر استفاده میشود

MB_DEFBUTTON1=&H1

MB_DEFBUTTON2=&H100

MB_DEFBUTTON3=&H200

MB_DEFBUTTON4=&H300

مقادیر رزرو شده زیر هم برای Align کردن استفاده میشود از دومین مقدار در سیستم های عربی برای Right To Left کردن پیامی که میخواهیم در این پنجره نمایان گردد.

MB_RIGHT=&H80000

MB_RTLREADING=&H100000 'Caption

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

Private Const EM_SETPASSWORDCHAR = &HCC

Private Const HC_ACTION =0

Private Shared hHook As Integer

Hook Typs : one of them

WH_CBT

The system calls a WH_CBT hook procedure before activating, creating, destroying, minimizing, maximizing, moving, or sizing a window; before completing a system command; before removing a mouse or keyboard event from the system message queue; before setting the input focus;

البته پیشنهاد میشه که یک فرم Custom Message Box بسازید چون Handle کردن پنجره یا پنجره ها با استفاده از توابع ویندوزی سخت است و اگر پنجره خطایی غیر از آن یا پنجره  ای ناخواسته باز شود کد به پنجره دیگری ارسال میشود و درست عمل نخواهد کرد ، در ضمن سیستم هنگ و مجبورید از اکسس خارج شوید با استفاده از Task Manager 

  

شکل تابع بصورت زیر است باید تمرین کنید تا مسلط شوید

  

Public Function Msgboxx(ByVal Prompt As String,Optional ByVal Title As String = "", Optional ByVal buttons As MessageBoxButtons =, Optional ByVal icon As MessageBoxIcon =, Optional ByVal DefaultButton As MessageBoxDefaultButton =, Optional ByVal options As MessageBoxOptions =, Optional ByVal m As MsgBoxStyle =) As DialogResult

hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgboxProc,GetModuleHandle(vbNullString),GetCurrentThreadId

  فرضا در اینجا از InputBox استفاده شده ولی شما بایستی از Msgboxx استفاده کنید 

InputBoxDK = InputBox(Prompt, Title)

UnhookWindowsHookEx hHook

Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, _
ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias _
"GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr


Private Declare PtrSafe Function SendDlgItemMessageA Lib "user32" Alias  (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Private Declare PtrSafe Function GetClassNameA Lib "user32" Alias (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long





Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr

If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)

برای گرفتن ClassName پنجره InputBox که 32770 است از تابع GetClassNameA استفاده شده

strClassName = String$(256, " ")

lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then 'A window has been activated

RetVal = GetClassName(wParam, strClassName, lngBuffer)

چک میکند که اگر پنجره InputBox بود پیامی را با تابع SendDlgItemMessage می فرستد که بجای کاراکتر وارد شده ستاره تایپ شود عرض کردم هندل کردن ویندو سخت است و اگر پنجره ای ناخواسته Run شود ممکن است سیستم هنگ نماید.

If Left$(strClassName, RetVal) = "#32770" Then

SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, asc("*"), &H0

لیست پیام هایی که میشود به Edit control یا تکست باکسی که در InputBox وجود دارد و در آن کاراکتری تایپ می کنید ، فرستاد. لینک زیر

edit-control-reference-messages

خط زیراطمینان حاصل خواهد کرد که سایر Hook ها که ممکن است داخل آن باشد بصورت درست فراخوانی شده باشد.

'This line will ensure that any other hooks that may be in place are 

'called correctly.

CallNextHookEx hHook, lngCode, wParam, lParam

برای لود کردن آیکون هم باید به پنجره پیامی فرستاد و از توابع ویندوزی استفاده نمود که به آن اشاره میشود.فقط Bitmap اگر PNG باشد باید تبدیل شود که به کدهای خیلی زیاد و پیچیده اس احتیاج است و از بحث اکسس خارج .

WM_SETICON message
wParam
ICON_BIG=1
ICON_SMALL=0
lParam
 handle to the new large or small icon. If this parameter is NULL, the icon indicated by wParamis removed.


Public Const WM_SETICON = &H80 Public Const ICON_SMALL = 0 Public Const ICON_BIG = 1


'// LoadImage() image types
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1
Public Const IMAGE_CURSOR = 2
Public Const IMAGE_ENHMETAFILE = 3 '// LoadImage() flags
Public Const LR_DEFAULTCOLOR = &H0
Public Const LR_MONOCHROME = &H1
Public Const LR_COLOR = &H2
Public Const LR_COPYRETURNORG = &H4
Public Const LR_COPYDELETEORG = &H8
Public Const LR_LOADFROMFILE = &H10
Public Const LR_LOADTRANSPARENT = &H20
Public Const LR_DEFAULTSIZE = &H40
Public Const LR_LOADMAP3DCOLORS = &H1000
Public Const LR_CREATEDIBHeader = &H2000
Public Const LR_COPYFROMRESOURCE = &H4000
Public Const LR_SHARED = &H8000


hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE) If hIcon<>0 Then
SendMessageA(hWnd, WM_SETICON, 0, ByVal hIcon)

در سیستم آفیس 32 بیت البته 

Private Declare Function LoadImageA Lib "user32  (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long

------------------------------

مثالی دیگر از MSGBOXHOOKPROC : 

SetDlgItemTextA function
Sets the title or text of a control in a dialog box.

SetDlgItemTextA( HWND hDlg, int nIDDlgItem, LPCSTR lpString)


Dim mFlags As VbMsgBoxStyle

Public Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = HCBT_ACTIVATE Then
SetWindowText wParam, mTitle
SetDlgItemText wParam, IDPROMPT,mPrompt

Select Case mFlags
 
Case vbAbortRetryIgnore
SetDlgItemText wParam, IDABORT, But1 SetDlgItemText wParam, IDRETRY, But2
SetDlgItemText wParam, IDIGNORE,But3

Case vbYesNoCancel
SetDlgItemText wParam, IDYES, But1
SetDlgItemText wParam, IDNO, But2 SetDlgItemText wParam, IDCANCEL,But3

Case vbOKOnly
SetDlgItemText wParam, IDOK, But1

Case vbRetryCancel
SetDlgItemText wParam, IDRETRY, But1
SetDlgItemText wParam, IDCANCEL,But2

Case vbYesNo
SetDlgItemText wParam, IDYES, But1 SetDlgItemText wParam, IDNO, But2

Case vbOKCancel
SetDlgItemText wParam, IDOK, But1 SetDlgItemText wParam, IDCANCEL, But2

End Select

UnhookWindowsHookEx hHook
End If

MsgBoxHookProc = False
End Function

Public Function
  

------------------------------

مثالی دیگر با استفاده از توابع API 

You need to use Windows Hooking API

You must create a CBT hook
Run a Message Box with CBT hook
Catch a HCBT_ACTIVATE message in the Hook procedure
Set new captions for the buttons using the SetDlgItemText function
(example below changes “Yes” and “No” captions to smiles: “:-)” and “:-(” )
Release the CBT hook


Public Sub MsgBoxSmile()
' Set Hook
hHook=SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc,0, GetCurrentThreadId)
'Run MessageBox
MsgBox "Smiling Message Box", vbYesNo, "Message Box Hooking"
End Sub  

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

If lMsg = HCBT_ACTIVATE Then 

SetDlgItemText wParam, IDYES, ":-)" 

SetDlgItemText wParam, IDNO, ":-("  

' Release the Hook UnhookWindowsHookEx 

hHook 

End If

MsgBoxHookProc = False 

End Function

در مثال یاد شده MsgBoxSmile را در رویداد یک باتن بگذارید اگر مشکلی پیش نیاید و پنجره MSGBOX را HOOK نماید ( گفته است که این پنجره شامل دوکلید YES و NO باشد) TEXT داخل این دو باتن تغییر خواهد کرد 

البته روش هوک کردن کار درستی نیست بخاطر اینکه زمان کار با کلیدها مسیج های زیادی رد و بدل میشود و چنانچه HWND پنجره درست بدست نیاید کار بیهوده ای خواهد بود و ممکن است سیستم هنگ و در پیش برد برنامه خللی وارد بنماید که مایکروسافت آفیس چنین پیشنهادی را نخواهد داد و عنوان می کنند که اگر کسی راغب است یک فرم بعنوان CUSTOM MESSAGE BOX بسازد و در آنها باتن هایی تعبیه نماید در نتیجه OFFICE هیچوقت پیشنهاد HOOKING را ارائه نخواهد داد....