سفارشی سازی MessageBox

Customizing MessageBox

(INT CBTMessageBox(hwnd,lpText, lpCaption,uType

hhk=SetWindowsHookEx(WH_CBT, Addressof CBTProc, 0, GetCurrentThreadId

CBTMessageBox=MessageBox(hwnd, lpText, lpCaption, uType)

(CBTProc(nCode,wParam,lParam

 

"hChildWnd; // msgbox is "child

 window handle is wParam '

if nCode=HCBT_ACTIVATE

 set window handles '

hChildWnd=wParam

 to get the text of the Yes button' 

(if (GetDlgItem(hChildWnd,IDYES)=0)

(CBTProc=SetDlgItemText(hChildWnd,IDYES,s

End if

(if (GetDlgItem(hChildWnd,IDOK)=0)

(CBTProc=SetDlgItemText(hChildWnd,IDOK,s

End if 

 exit CBT hook '

(UnhookWindowsHookEx(hhk

 otherwise, continue with any possible chained hooks '

else

(CallNextHookEx(hhk, nCode, wParam, lParam

CBTProc=0

End If 

: Source 

MessageBox-with-Custom-Button-Captions

 : utype 

Dim DM As DRAWITEMSTRUCT

(CopyMemory DM,lparam,Len(DM

Window Message'

Public Const WM_DRAWITEM= &H2B

Owner draw control types'
Const ODT_MENU = 1
Const ODT_LISTBOX = 2
Const ODT_COMBOBOX = 3
Const ODT_BUTTON = 4

' Owner draw actions'
Const ODA_DRAWENTIRE = &H1
Const ODA_SELECT = &H2
Const ODA_FOCUS = &H4

' Owner draw state'
Const ODS_SELECTED = &H1
Const ODS_GRAYED = &H2
Const ODS_DISABLED = &H4
Const ODS_CHECKED = &H8
Const ODS_FOCUS = &H10

 MEASUREITEMSTRUCT for ownerdraw'
Type MEASUREITEMSTRUCT
        CtlType As Long
        CtlID As Long
        itemID As Long
        itemWidth As Long
        itemHeight As Long
        itemData As LongPtr
End Type

 DRAWITEMSTRUCT for ownerdraw'
Type DRAWITEMSTRUCT
        CtlType As Long
        CtlID As Long
        itemID As Long
        itemAction As Long
        itemState As Long
        hwndItem As LongPtr
        hdc As LongPtr
        rcItem As RECT
        itemData As LongPtr
End Type

System Classes

DrawCaption  hwnd,hdc,rc,uflag

http:// uflag : DC_ACTIVE DC_ICON DC_TEXT

Public Const DC_ACTIVE = &H1

Public Const DC_NOTACTIVE = &H2

Public Const DC_ICON = &H4

Public Const DC_TEXT = &H8



 


Public Function HookProc(ByVal nCode As Long,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As Longptr

if nCode>=0 Then 
Dim tCWP As CWPSTRUCT
(CopyMemory tCWP,ByVal lParam,Len(tCWP
if tCWP.message=WM_CREATE Then 
If tCWP.hwnd==#32770 Then
lprewnd=SetWindowLongPtrA(tCWP.hwnd,GWL_CALL
(WNDPROC,AddressOf SubDlgBox
End If 
End if 
Else
CallWndProc= CallNextHookEx(0,nCode,wParam,ByVal 
(lParam
End If 
End Function 



Public Function CallWndProc(ByVal hwnd As LongPtr,Msg As Long,Byval wParam As Longptr,ByVal lParam As LongPtr) As Longptr 

Select Case Msg 
Case WM_DESTROY
SetWindowLongPtrA hwnd,GWL_CALLWNDPROC,lprewnd
End Select CallWndProc=CallWindowProcA(lprewnd,hwnd,,Msg,w
(Param,lParam
End Function


' Button SubClassed procedure 



FUNCTION ButtonProc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG,BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG 

SELECT CASE wMsg 

CASE %WM_LBUTTONDBLCLK 

forward this for rapid button '
clicking... '

Call SendMessage(hWnd,%WM_LBUTTONDOWN,wParam
(lParam, 

ButtonProc=0 : EXIT FUNCTION 

CASE %WM_ERASEBKGND 

ButtonProc=1: EXIT FUNCTION 

END SELECT 

ButtonProc=CallWindowProc(glpButtonProc 
(hWnd, wMsg, wParam, lParam, 

END FUNCTION




Public Function SubMsgBox(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long 



Select Case Msg

     Case WM_DESTROY 

     Remove the MsgBox Subclassing' 

Call SetWindowLong(hwnd,GWL_WNDPROC 
(lPrevWnd,

End Select 

SubMsgBox = CallWindowProc(lPrevWnd,hwnd,Msg 
(wParam, ByVal lParam,

End Function






Private Function HookWindow(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long 

Dim tCWP As CWPSTRUCT  CopyMemory tCWP 
(ByVal lParam, Len(tCWP, 

If tCWP.message=WM_CREATE Then 

If sClass="#32770" Then 

Subclass the Messagebox as it's created' 

lPrevWnd=SetWindowLong(tCWP.hwnd 
(GWL_WNDPROC,AddressOf SubMsgBox, 

End If 

End If 

HookWindow=CallNextHookEx(lHook, nCode 
(wParam, ByVal lParam,

End Function 





Public Function MsgBoxEx(ByVal Prompt As String, Optional ByVal Buttons As Long = vbOKOnly, Optional ByVal Title As String) As Long 

Dim lReturn As Long 

lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWindow, App.hInstance 
(App.ThreadID,
(lReturn=MsgBox(Prompt, Buttons, Title

(Call UnhookWindowsHookEx(lHook 

MsgBoxEx = lReturn

End Function