Hook و UnHook کردن پنجره برای مدیریت پیام های ویندوزی

Hook نقطه ای در مکانیزم مدیریت پیام سیستم است که در آن یک برنامه می تواند یک برنامه فرعی برای نظارت بر رفت و آمد پیام  در سیستم نصب کند و انواع خاصی از پیام ها را قبل از رسیدن به رویه ( Procedure )پنجره هدف پردازش نماید.

1- استفاده از تابع SetWindowsHookExA برای ویندوز 64 بیتی یا Vba7 این تابع 3 آرگومان دارد اولی یه ثابت است مثل WH_CBT=5 ( نصب یک رویه زنجیری که اعلان ها را دریافت می نماید CBTProc ) یا WH_MOUSE=7  ( نصب یک رویه که پیام های Mouse را مانیتور می کند MouseProc) دومین آرگومان یک تابع CallBack است وبا AddressOf  و نام تابع مشخص میگردد ، سومی hmod که Null است و چهارمین آرگومان شناسه یک Thread است که تابع GetCurrentThreadId  را در آن قرار می دهیم.( شناسه ی Thread یا رشته ای که با یک رویه Hook قرار است در ارتباط باشد.برای اپلیکیشن های دسکتاپ اگر این پارامتر صفر باشد رویه هوک مرتبط میشود با تمام Thread های در حال اجرا در دسکتاپ مشابه در زمان فراخوانی Thread )

2-درآمدن از زنجیره ی هوک با تابع UnHookWindowsHookEx که حتما باید انجام گیرد.

دقیقا توابع ویندوزی ( نوشتاری ) به حروف کوچک و بزرگ حساسند یا باید در کتابخانه مذکور موجود باشند.فرضا kernel32 باشد ولی user32 نوشته شود.اینها همه باعث خطا می شود.

Function HookWnd()

hhk=SetWindowsHookExA(WH_CBT,AddressOf CBTProc,0&,GetCurrentThreadId)

End Sub

Function CBTProc(Byval Msg As Long,Byval wParam As LongPtr,Byval lParam As LongPtr) As LongPtr

if Msg=5

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

UnHookWindowsHookEx hhk

End if

CBTProc=False

End 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.

LRESULT CallNextHookEx( [in, optional] HHOOK hhk, [in] int nCode, [in] WPARAM wParam, [in] LPARAM lParam );

Calling CallNextHookEx is optional, but it is highly recommended; otherwise, other applications that have installed hooks will not receive hook notifications and may behave incorrectly as a result. You should call CallNextHookEx unless you absolutely need to prevent the notification from being seen by other applications.

فراخوانی CallNextHookEx انتخابی است اما به شدت توصیه میشود ، در غیر اینصورت سایر برنامه هایی که hook یا قلاب ها را نصب کرده اند ( رویه های فرعی ) اعلان های hook را دریافت نخواهند کرد و ممکن است نتیجه نادرستی داشته باشند.بایستی این تابع فراخوانی شود ، مگر اینکه کاملا لازم باشد از مشاهده اعلان توسط سایر برنامه ها جلوگیری کنید.

'تغییر ویژگی پنجره مشخص شده 

LONG_PTR SetWindowLongPtrA( [in] HWND hWnd, [in] int nIndex, [in] LONG_PTR dwNewLong );

'SubClass Window

Public PreWnd As LongPtr

Public IsSubclassed As Boolean

Function SubClassWnd()

PrevWnd=SetWindowLongPtrA (hWnd,GWLP_WNDPROC,AddressOf WNDProc)

End Function

Function UnSubClassWnd()

if Not IsSubClassed Then 

SetWindowLongPtrA (hWnd,GWLP_WNDPROC,PrevWnd)

IsSubClassed=True

Me.Caption=SubClassed

Else

IsSubClassed=False

End If 

End Function

گرفتن نام کلاس پنجره با تابع زیر 

نام کلاس  جعبه پیام ویندوزی  32770# است

int GetClassNameA( [in] HWND hWnd, [out] LPSTR lpClassName, [in] int nMaxCount );

lpClassName:

variable  Buffer=String(35,vbNullChar)

nMaxCount:

Len(Buffer)

lRet=GetClassNameA(hWnd,Buffer,Len(Buffer)

If the function succeeds, the return value is the number of characters copied to the buffer, not including the terminating null character.

اگر تابع موفق عمل کند ، مقدار برگشتی ( integer : عدد صحیح ) عددی از کاراکترهای کپی شده به بافر است .بخاطر همین در بالا کاراکترهای خالی در حافظه موقت ایجاد شد

Char=Left(Buffer,lRet)

ارسال پیام به کنترل دیالوگ باکس :

SendDlgItemMessageA( [in] HWND hDlg, [in] int nIDDlgItem, [in] UINT Msg, [in] WPARAM wParam, [in] LPARAM lParam

HANDLE LoadImageA( [in, optional] HINSTANCE hInst, [in] LPCSTR name, [in] UINT type, [in] int cx, [in] int cy, [in] UINT fuLoad

fuLoad:LR_LOADFROMFILE=&H10

BM_SETIMAGE : &HF7 : 15×16+7=247

یک تصویر جدید ( icon یا bitmap ) را با باتن مرتبط می کند

wParam : IMAGE_BITMAP Or IMAGE_ICON

lParam : hBitmap Or hLoadImage Or HICON

h:Handle To

HICON LoadIconA( [in, optional] HINSTANCE hInstance, [in] LPCSTR lpIconName );

IDI_APPLICATION=32512
IDI_HAND=32513
IDI_QUESTION=32514
IDI_ASTERISK=32516

LoadIconA 0&,IDI_APPLICATION

USER32

Programs call functions from Windows USER to perform operations such as creating and managing windows, receiving window messages (which are mostly user input such as mouse and keyboard events, but also notifications from the operating system), displaying text in a window, and displaying message boxes.

برنامه ها توابع را از Windowse User برای اجرای عملیاتی مثل ایجاد یا مدیریت پنجره ها ، دریافت پیام های پنجره ( که کاربر وارد می کند مثل رویدادهای کیبورد و ماوس ، اما همچنین اعلان هایی از سیستم عملیاتی ) ، مشاهده متن در یک پنجره و مشاهده جعبه های پیام فراخوانی می نمایند.

• Hook Chains
• Hook Procedures
• Hook Types
• WH_CALLWNDPROC and WH_CALLWNDPROCRET
• WH_CBT
• WH_DEBUG
• WH_FOREGROUNDIDLE
• WH_GETMESSAGE
• WH_JOURNALPLAYBACK
• WH_JOURNALRECORD
• WH_KEYBOARD_LL
• WH_KEYBOARD
• WH_MOUSE_LL
• WH_MOUSE
• WH_MSGFILTER and WH_SYSMSGFILTER
• WH_SHELL

UINT_PTR SetTimer( [in, optional] HWND hWnd, [in] UINT_PTR nIDEvent, [in] UINT uElapse, [in, optional] TIMERPROC lpTimerFunc );

BOOL KillTimer( [in, optional] HWND hWnd, [in] UINT_PTR uIDEvent );

Creating a Timer.

'no timer callback

Private IDT_TIMER1 As Long

Private IDT_TIMER2 As Long

Sub StopClock()
 
    KillTimer 0, lTimerID
    lTimerID = 0
 
End Sub
 

SetTimer hwnd,IDT_TIMER1,10000,NULL
SetTimer hwnd,IDT_TIMER2,300000,NULL


Select Case Msg

'DECIMAL :1×16^(2)+1×16^(1)+3×16^(0)=275

'HEXADECIMAL : &H113

case WM_TIMER  '&H113
     Select Case wParam
         case IDT_TIMER1
            'process the 10-second timer
            'return 0
        case IDT_TIMER2
           'process the five-minute timer
           'return 0
End Select
End Select

MOUSEMOVE / XPOS

WParwm : LBUTTON Or RBUTTON

lParam

Lo مختصات x کرسر را مشخص میکند . مختصات مرتبط با گوشه چپ بالایی از منطقه Client

The low-order word specifies the x-coordinate of the cursor. The coordinate is relative to the upper-left corner of the client area

ho مختصات y کرسر را مشخص میکند . مختصات  مرتبط با گوشه چپ بالایی منطقه Client

The high-order word specifies the y-coordinate of the cursor. The coordinate is relative to the upper-left corner of the client area

در کل مختصات x و y  گوشه چپ بالایی منطقه Client را مشخص می نماید. 

---

Case WM_MOUSEMOVE

         Dim rw As RECT

         Dim rc As RECT

         Dim pp As POINTAPI

         GetWindowRect BtnOk, rw

         pp.x = rw.left

         pp.y = rw.top

         ClientToScreen BtnOk, pp

         GetCursorPos pp

         If Not PtInRect(rw, pp) Then'

         ' MsgBox "rt'

         'End If'

         SetWindowTextA hwnd, pp.x & "," & pp.y & "...." & rw.left & "," & rw.top

---

اگر ازGetClientRect استفاده کنید مختصات left و Topرا صفر میدهد.

dim rw As RECT

GetWindowRect hwndBtnOk,rw

dim pp as POINTAPI

(pp.x = LoWord(lParam

        ( pp.y = HiWord(lParam

          MoveWindow hwndBtnOk, pp.x, pp.y, (rw.right - rw.left), (rw.bottom - rw.top), 1

The &H prefix denotes a number represented in hexadecimal (base 16) notation.

Hexadecimal digits, like decimal, start at 0, but go up to 

.(F (16

e.g. 0 1 2 3 4 5 6 7 8 9 A B C D E F, 10 11 12 13 14 15 16 17 18 19 1A 1B etc.

In C-based languages hexadecimal numbers are prefixed with 0x, eg. 0x10000. This is directly equal to 

H10000 in VB&

Hex To Decimal

قلاب کردن پنجره 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

قلاب کردن InputBox برای ارسال پیام ویندوزی به آن HOOK /SUBCLASS

تست نشده ولی جواب خواهد داد توابع برای استفاده در Win32 است در Win64 نحوه ی اظهار توابع فرق میکند که در لینک توابع API  در [ پیوندها ] ،  نحوه ی صحیح آن در سایت خارجی درج شده.

Option Explicit 

Necessary constants  for hooking '

Private Const HCBT_ACTIVATE=5

Public Const WH_CBT=5 

Constants for password masking '

Public Const EM_SETPASSWORDCHAR= &HCC 

 Working variables that require global scope in hooking'

module 

Private hHook As Long 

 The API declarations we need 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 

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

Declare Function SendMessage Lib "user32" Alias

 SendMessageA" (ByVal hwnd As Long, ByVal wMsg"

As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

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

 Wrapper for the normal InputBox function'

Public Function vbInputBox(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Single, Optional YPos As Single, Optional Helpfile As String, Optional Context As Long) As String 

Optional Buttons As VbMsgBoxStyle = vbOKOnly,'

Optional Title As String, Optional HelpFile As String,' 

Optional Context As Long) As Long ,'

hHook=SetWindowsHookEx(WH_CBT, AddressOf 

(CBTProc,GetModuleHandle(vbNullString), 0

vbInputBox=InputBox(Prompt, Title, Default, Xpos, 

(YPos, Helpfile, Context)

 End Function

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

Dim hwndEditControl As Long 

If lMsg=HCBT_ACTIVATE And ClassName="#32770" Then

("","hwndEditControl=FindWindowEx(wParam,0,"Edit

 get the edit control'

If hwndEditControl Then

Do your stuff here to modify the window'

SendMessage hwndEditControl,

EM_SETPASSWORDCHAR, Asc("*"), 0,

Immediately unhook'

UnhookWindowsHookEx hHook

End If

'allow operation to continue'

CBTProc = 0

End Function

---

مثال دیگر از فروم خارجی 

Private Declare Function CallNextHookEx Lib "user32

ByVal hHook As Long,ByVal ncode As Long, ByVal)

wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName 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

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

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

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

'Constants to be used in our API functions 

Private Const EM_SETPASSWORDCHAR =&HCC

Private Const WH_CBT=5

Private Const HCBT_ACTIVATE=5

Private Const HC_ACTION=0

Private hHook As Long 

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

Dim RetVal

If lngCode<HC_ACTION Then

(NewProc=CallNextHookEx(hHook,lngCode,wParam,lParam

Exit Function

End

If lngCode=HCBT_ACTIVATE Then

A window has been activated'

If ClassName="#32770" Then

Class name of the Inputbox'

 This changes the edit control'

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

End If

End If

CallNextHookEx hHook,lngCode,wParam, lParam

End Function

Function InputBoxDK(Prompt,Title) As String

Dim lngModHwnd As Long,lngThreadID As Long

lngThreadID=GetCurrentThreadId lngModHwnd 

(GetModuleHandle(vbNullString

hHook=SetWindowsHookEx(WH_CBT, AddressOf 

(NewProc,lngModHwnd,lngThreadID

(InputBoxDK=InputBox(Prompt,Title

UnhookWindowsHookEx hHook

End Function

WH_CBT ( قلاب یا گرفتن پنجره : برای ارسال پیام ازطریق پنجره به زیر پنجره ها Child Window:کنترل پیام های پنجره Window Message)

Tested SuccesFully..... 64 BIT

HOOK/SUBCLASS THE WINDOW

CustomMeSsageBox

(Public Const GWL_WNDPROC = (-4

Public Const HCBT_CREATEWND = 3

Public Const HCBT_DESTROYWND = 4

Public Const HCBT_ACTIVATE = 5

Public Const WM_INITDIALOG = &H110

Public Const WM_COMMAND = &H111

Public Const WM_SYSCOMMAND = &H112

case WM_PAINT

(hdc=BeginPaint(hWnd,ps

((whitebrush=CreateSolidBrush(RGB(0, 0, 0

' Erases the background 

SendMessage(hWnd,WM_ERASEBKGND,

(GetDC(hWnd),0,

(GetClientRect(hWnd,rc

(FillRect(GetDC(hWnd),rc,whitebrush

Can Use DrawEdge' 

 Draw the icon in the client area' 

DrawIcon hdc, 10,20,ByVal  hIcon1' 

(EndPaint(hWnd,ps

drawcaption

win32/gdi/painting-and-drawing-functions

Addingplusimageplusinplusapluswin32plusdialog

You need to handle WM_CTLCOLORDLG. You should return a brush handle. For example, to make the background white:

case WM_CTLCOLORDLG:
    return (INT_PTR)GetStockObject(WHITE_BRUSH);

' Not Tested In VBA Just Following 
Code Copied Here

HDC hdcMem

LPDRAWITEMSTRUCT lpdis

Select Case message

case WM_INITDIALOG

'hbm1 and hbm2 are defined globally.

hbm1 = LoadBitmap((HANDLE) hinst, "OwnBit1")

hbm2 = LoadBitmap((HANDLE) hinst, "OwnBit2")

return TRUE

case WM_DRAWITEM

lpdis=(LPDRAWITEMSTRUCT) lParam

hdcMem = CreateCompatibleDC(lpdis.hDC)

if (lpdis->itemState & ODS_SELECTED)

'if selected

SelectObject(hdcMem,hbm2)

else

SelectObject(hdcMem,hbm1)

'Destination

StretchBlt lpdis.hDC,lpdis.rcItem.left,lpdis.rcItem.top,lpdis.rcItem.right-lpdis.rcItem.left,lpdis.rcItem.bottom-lpdis.rcItem.top,hdcMem,0,0,32,32,SRCCOPY

DeleteDC hdcMem

return TRUE

End If

case WM_COMMAND

if (wParam= IDOK Or wParam=IDCANCEL) Then 

EndDialog hDlg, TRUE

return TRUE

End If

if (HIWORD(wParam)=BN_CLICKED) Then

Select Case  (LOWORD(wParam)) 

  case IDB_OWNERDRAW

End Select 

End If

case WM_DESTROY

DeleteObject hbm1

DeleteObject hbm2

End Select 

return FALSE

' Not Tested

case WM_CREATE
hdc = GetDC(hwnd)	
'xPixel = GetDeviceCaps(hdc, ASPECTX) 'yPixel = GetDeviceCaps(hdc, ASPECTY) 		ReleaseDC hwnd, hdc
SetTimer hwnd,ID_TIMER,50,NULL		return 0

case WM_SIZE

xCenter=(cxClient=LOWORD(lParam))/2		yCenter=(cyClient=HIWORD(lParam))/2

cxRadius=cyRadius=min(cxClient, cyClient)/16	
		
cxMove=max(1, cxRadius/2)
cyMove = max(1, cyRadius / 2)
		

cxTotal=2 * (cxRadius + cxMove)		
cyTotal=2 * (cyRadius + cyMove)



case WM_TIMER
hdc = GetDC(hwnd)
hdcMem = CreateCompatibleDC(hdc); 		SelectObject hdcMem, hBitmap)
BitBlt hdc,xCenter-cxTotal/2, yCenter -cyTotal/2,cxTotal,cyTotal,hdcMem,0,0, SRCCOPY)
ReleaseDC hwnd, hdc
DeleteDC hdcMem




Timers and Animation animation


BackGround Color question-146319

فرآیند پیام ارسال شده به پنجره WindowProc

Subclassing Controls

WindowProc callback function

Declare PtrSafe Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long

Declare PtrSafe Function SetWindowLongPtrA Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long,ByVal dwNewLong As LongPtr) As Long

(Public Const GWL_WNDPROC = (-4

Global oldwndproc As LongPtr

Global wndHW As LongPtr

: Form_Load

wndHw=Me.Hwnd

(oldwndproc = SetWindowLongPtrA(Me.hwnd, GWL_WNDPROC, AddressOf WndProc

: Form_Unload

SetWindowLongPtrA wndHw, GWL_WNDPROC, oldwndproc

Public Function WndProc(ByVal lhwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long

If uMsg = 516 Then 'WM_RBUTTONDOWNU           

        'Debug.Print "Intercepted WM_CONTEXTMENU at " & Now                        

       " MsgBox "Mouse Right Button Was Clicked                       

          WndProc=-1                      

ElseIf uMsg = WM_KEYDOWN Then        

           MsgBox wParam                    

             WndProc = True                    

     Else ' Send all other messages to the default message handler     

        (WndProc = CallWindowProcA(oldwndproc, lhwnd, uMsg, wParam, lParam

     End If

End Function

Public Const WM_KEYDOWN = &H100

Public Const WM_KEYUP = &H101

Public Const WM_CHAR = &H102

Public Const VK_RETURN = &HD

Public Const VK_UP = &H26

Public Const VK_DOWN = &H28

Public Const VK_HOME = &H24

Public Const VK_LEFT = &H25

Public Const VK_PRIOR = &H21

Public Const VK_LBUTTON = &H1  ' Left mouse button

Public Const VK_RBUTTON = &H2  ' Right mouse button

Public Const VK_MBUTTON = &H4  ' Middle mouse button (three-button mouse)

Public Const SC_SIZE = &HF000&

Public Const SC_MOVE = &HF010&

Public Const SC_MINIMIZE = &HF020&

Public Const SC_MAXIMIZE = &HF030&

Public Const SC_NEXTWINDOW = &HF040&

Public Const SC_PREVWINDOW = &HF050&

Public Const SC_CLOSE = &HF060&

Const WM_NCLBUTTONDOWN As Integer = 161
        Const WM_SYSCOMMAND As Integer = 274
        Const HTCAPTION As Integer = 2
        Const SC_MOVE As Integer = 61456

        If (Msg = WM_SYSCOMMAND) And (WParam = SC_MOVE) Then
            Return
        End If

        If (Msg = WM_NCLBUTTONDOWN) And (WParam = HTCAPTION) Then
            Return
        If (Msg = WM_RBUTTONDOWN) And (WParam = WM_RBUTTONDOWN) Then
            Return
        End If

    

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

If umsg = WM_NCLBUTTONDBLCLK And wParam = 2 Then Exit Function

SYsMenu عمل نکردن منوهای تایتل بار یا 

If umsg = WM_SYSCOMMAND And ((wParam = SC_CLOSE) Or (wParam = SC_MINIMIZE) Or (wParam = SC_MAXIMIZE)) Then

Exit Function

مثال دیگر :

    wm-ncdestroy   &H82

If Msg = WM_NCDESTROY Then 

SetWindowLong hWnd,GWL_WNDPROC,OldWindowProc

End If 

wm-contextmenu  &H7B

If Msg <> WM_CONTEXTMENU Then

NoPopupWindowProc = CallWindowProc(OldWindowProc,hWnd

,Msg,wParam,lParam)

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

 اگر از HOOK  استفاده شود و آیدی WH_MOUSE یا WH_MOUSE_LL

If Wparam=WM_NCLBUTTONDBLCLK Then 

     MouseHookProc=NoneZero

End If

WM_RBUTTONDOWN   wm-rbuttondown   &H204

(20×16)×1.6+4=516 ( DECIMAL )

516÷16=32  

516-(32×16)=4

(516÷16)×10=320

320÷16=20

List Of Windows Message  SendMessageList

SubClassing

SetWindowSubclass hwnd,SubClassProc&,1,0

 SubClassProc(Byval hwnd as Longptr,Byval uMsg As Long,Byval wParam as LongPtr,Byval lParam As LongPtr,Byval uId As Long,Byval dwRef as Long) As LongPtr

DefSubClassProc Hwnd,uMsg,wParam,lParam

RemoveWindowSubClass hwnd,SubClassProc&,1

GWL_WNDPROC=-4

lpfnOld=SetWindowLongA(hwnd,GWL_WNDPROC,Address

( Of WndProc

(Of WNDProc

   ( GetPropA hwnd,lPstring       (Retrieve A Data Handle 

SetPropA hwnd,lPstring,hData

RemovePropA hwnd,lPstring 

WndPro(Byval hwnd as LongPtr,Byval uMsg

 as Long,Byval wParam as LongPtr,Byval lParam as LongPtr) As LongPtr

Select Case uMsg

Case WM_NCDESTROY ' &H82

  Call UnSubClass( hwnd)   'Built-In Function

End Select

)WndProc=CallWindowProcA

((GetPropA(hwnd,OldWndProc),hwnd,uMsg,wParam,lParam