sucbclassing?

[MPrestonf12]

Does anyone have a simple(respectivly) snippet of subclassing. It seems all the code I look at is a very advanced routine. Thanks

Add this to a module

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const WM_NCLBUTTONUP = &HA2
Public Const HTMAXBUTTON = 9
Public OldWndProc As Long
Public TheText  As String

Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_NCLBUTTONDOWN Then
        If wParam = HTMAXBUTTON Then
            TheText = "hello"
        End If
    End If
    WindProc = CallWindowProc(OldWndProc, hwnd, wMsg, wParam, lParam)
End Function

Public Sub Hook(hwnd As Long)
    OldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindProc)
End Sub

Public Sub UnHook(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, OldWndProc
    OldWndProc = 0
End Sub

and add this to a form with 3 command buttons

Private Sub Command1_Click()
Hook Me.hwnd
End Sub

Private Sub Command2_Click()
UnHook Me.hwnd
End Sub

Private Sub Command3_Click()
MsgBox TheText
End Sub

This will make a message box popup hello when the maximize button is pushed.

[agent]

I've also been looking for this code for a while.

[Edited by agent on 08-29-2000 at 10:29 PM]

You can almost call it an 'InterceptMessage' function because that's basically what it does. Anything message sent to the window can be intercepted and in some cases; re-coded .

[MPrestonf12]

Thanks for the code and help!!

[MPrestonf12]

Dennis, do I have to first hook he window command1. When I do that and maximize the form nothing happpens. it only happens when I hit command 3?

This should work.

Code for a Module

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const GWL_WNDPROC = (-4)
Const WM_NCLBUTTONDOWN = &HA1
Const HTMAXBUTTON = 9

Public WndProcOld As Long

Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    If wMsg = WM_NCLBUTTONDOWN Then
        If wParam = HTMAXBUTTON Then
            MsgBox ("You pressed Maximize")
        End If
    End If
  
    WindProc = CallWindowProc(WndProcOld&, hwnd&, wMsg&, wParam&, lParam&)
    
End Function

Sub SubClassWnd(hwnd As Long)
    WndProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindProc)
End Sub

Sub UnSubclassWnd(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, WndProcOld&
    WndProcOld& = 0
End Sub

Code for Form

Private Sub Form_Load()
    SubClassWnd hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnSubclassWnd hwnd
End Sub

I would have done that too, but I wasnt sure if you were aloud to have MsgBox's inside of Modules.

Also,
Megatron:
Is there anyway for you to Subclass, so all other Window's Procedures are called(like if you clicked a command button, etc) but not the one you are waiting for??
like if I didnt want the form to maximize, but if I leave out CallWindowProc VB Freezes, I have to hit the stop button a few times, Then Ctrl-Alt-Del to EndTask VB, then VB asks if I want to save changes to the project, I just hit cancel, and its back to normal... but back to my original question, how would I only leave out the Window that I want to do stuff to(IE: the max button).... because I dont want the form maximized, just a message popped up(I dont really need this, I just want to know how it works.)

Thanks,
Dennis

[MPrestonf12]

The code works good and I'm trying to figure it out but there is one thing I need help on. First what is WndProcOld?
Thanks

WndProcOld contains the old Procedure's address, if you dont use SetWindowLong with the old procedures address(wndprocold) VB will crash, because it's still listening for your function(WndProc) but it cant find it....
I hope this made sense.

[MPrestonf12]

ok, i see it better now thanks for your help

Dennis,

Simply exit the function when you recieve the HTMAXBUTTON message. The reason your VB was freezing was because you left out CallWindowProc for every message (hence no messages were processed). This next example should clear things up.

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const GWL_WNDPROC = (-4)
Const WM_NCLBUTTONDOWN = &HA1
Const HTMAXBUTTON = 9

Public WndProcOld As Long

Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    If wMsg = WM_NCLBUTTONDOWN Then
        If wParam = HTMAXBUTTON Then
            MsgBox ("You pressed Maximize")
            Exit Function
        End If
    End If
  
    WindProc = CallWindowProc(WndProcOld&, hwnd, wMsg, wParam, lParam)
    
End Function

Sub SubClassWnd(hwnd As Long)
    WndProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindProc)
End Sub

Sub UnSubclassWnd(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, WndProcOld&
    WndProcOld& = 0
End Sub

[agent]

This only seems to work inside the vb app that calls it. I need to subclass an app outside of my own.

[Edited by agent on 08-31-2000 at 01:55 AM]