قلاب کردن پنجره HOOK و دسترسی به کلاس های آن از طریق Subclass کردن

در WIN32 : 

Private Type CWPSTRUCT

lParam As Long

wParam As Long

message As Long

hwnd As Long

End Type

End Type 

Private Const SWP_FRAMECHANGED=&H20

Private Const SWP_NOSIZE=&H1

Private Const SWP_NOZORDER=&H4

Private Const WH_CALLWNDPROC=4

(Private Const GWL_WNDPROC=(-4

Private Const WM_GETFONT=&H31

Private Const WM_CREATE=&H1

Private Const WM_CTLCOLORBTN=&H135

Private Const WM_CTLCOLORDLG=&H136

Private Const WM_CTLCOLORSTATIC=&H138

Private Const WM_CTLCOLOREDIT=&H133

Private Const WM_DESTROY=&H2

Private Const WM_SHOWWINDOW=&H18

Private Const WM_COMMAND=&H111

Private Const BN_CLICKED=0

Private Const IDOK=1

 

Private Const EM_SETPASSWORDCHAR =&HCC

Private INPUTBOX_HOOK As Long

Private INPUTBOX_HWND As Long

Private INPUTBOX_PASSCHAR As String

Private INPUTBOX_FONT As String

Private INPUTBOX_SHOWING As Boolean

Private INPUTBOX_OK As Boolean

Public Function InputBoxEx(ByVal Prompt As String,Optional ByVal Title As String,Optional ByVal FontName As String,Optional ByVal FontSize As Long, Optional ByVal PasswordChar As String,Optional ByVal CancelError As Boolean = False) As String

"INPUTBOX_FONT="MS Sans Serif

INPUTBOX_FONTSIZE=8

INPUTBOX_PASSCHAR=PasswordChar

If Len(FontName) Then INPUTBOX_FONT=FontName

If FontSize>0 Then INPUTBOX_FONTSIZE=FontSize

INPUTBOX_SHOWING = True

INPUTBOX_HOOK=SetWindowsHookEx(WH_CALLWNDPROC,AddressOf 

(HookWindow,0,GetCurrentThreadID

(InputBoxEx=InputBox(Prompt,Title,Context

INPUTBOX_SHOWING=False

 Remove The Hook'

(UnhookWindowsHookEx(INPUTBOX_HOOK

If Not INPUTBOX_OK And CancelError Then Err.Raise vbObjectError + 1, , "User Pressed " & Chr(34) & "Cancel" & Chr(34)

End Function

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

Dim tCWP As CWPSTRUCT

This is where you need to Hook the Inputbox'

(CopyMemory tCWP, ByVal lParam, Len(tCWP

If tCWP.message=WM_CREATE Then

     If ClassName ="#32770" Then

         If INPUTBOX_SHOWING Then

INPUTBOX_HWND=SetWindowLong(tCWP.hwnd,GWL_WNDPROC,AddressOf 

(InputBoxProc

          End If

     End If

End If HookWindow=CallNextHookEx(INPUTBOX_HOOK,nCode,wParam,ByVal lParam)

End Function

Private Function InputBoxProc(ByVal hwnd As Long,ByVal Msg As Long, ByVal wParam As Long,ByVal lParam As Long) As Long

Select Case Msg

    Case WM_COMMAND

        '..Check to see if the OK Button was Pressed'

       lNotify=Val("&H" & Left$(Right$("00000000" & Hex$(wParam), 8), 4))

       lID = Val("&H" & Right$(Right$("00000000" & Hex$(wParam), 8), 4))

       If lNotify = BN_CLICKED Then

          (INPUTBOX_OK = (lID = IDOK

       End If

Case WM_SHOWWINDOW

      GetWindowRect(hwnd, tRECT

     SetWindowPos hwnd,0, tRECT.Left,tRECT.Top,0,0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED)

Case WM_CTLCOLORDLG,WM_CTLCOLORSTATIC,WM_CTLCOLORBTN,WM_CTLCOLOREDIT

.

.

.

If Msg=WM_CTLCOLORSTATIC Then
Set the Font'
lFont=CreateFont(((INPUTBOX_FONTSIZE/72)*96),0,0,0,0,0,0,0,0,0,0,0,0, 

(INPUTBOX_FONT
SelectObject wParam,lFont
End If

tLB.lbColor=INPUTBOX_BACKCOLOR

(InputBoxProc = CreateBrushIndirect(tLB

 Case WM_DESTROY

    Remove the Inputbox Subclassing'

Call SetWindowLong(hwnd,GWL_WNDPROC, INPUTBOX_HWND)

End Select

InputBoxProc=CallWindowProc(INPUTBOX_HWND,hwnd,Msg,wParam,ByVal lParam)

End Function