How does one cast in VB 6? Specifically Long to RECT 2

[neseidus]

Hi

I'm subclassing a form to handle mouse wheel messages and also to handle setting a minimum width/height but in order to do the latter I have to convert 'lParam' into a RECT, which I don't know how to do, or if that's possible.

Has anyone else come across this problem?

 

[neseidus]

I've been trying to get it working by using the CopyMemory function to get around the cast but so far this isn't working

 

[petermeachem]

What I do is:-

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Dim lr As RECT

lr.left = 1 etc

http://www.accuflight.com

http://www.lettersdirect.co.uk

http://www.ourhouseinportugal.co.uk/

 

[neseidus]

Well I can create a new RECT fine, the trouble is that according to MSDN the lParam parameter passed into wndproc (see below) is a RECT, so I need to cast it

...

'subclass window
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WndProc)

....

Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, _
                                            ByVal lParam As Long) As Long
            
    Select Case uMsg
    
        Case WM_MOUSEWHEEL
            ' Handle mouse wheel
            
        Case WM_MOVING
            'Somehow get the RECT out of the lParam
            
            Dim R As RECT
            
            ' My attempt that doesn't work:                            
            CopyMemory R, lParam, Len(lParam)
                    
    End Select
        
    WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
End Function

 

[strongm]

Len(R) would be a good step in the right direction

 

[CassandraR]

Hi neseidus:

Some ramblings from little ol' me.

lParam in your code is a Long.

R is a structure of four Longs.

Copying lParam to R would only provide a value for Left, the first Long item in R.

Since you are trying to pass a RECT structure as the lParam to CallWinProc, why not use:

WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, R)

Cassandra

 

[CubeE101]

Have you read this Thread yet?

thread222-902639

You might find your answer there...

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[CubeE101]

And thread222-494440 for Min Form Sizes...

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[CubeE101]

Here is the collective code from both Threads, I merged them into one and commented out the duplicate declarations, and preserved credit, please visit the 2 threads listed above an thank the respective contributers:
Hypetia & strongm

you need a project with:
Form
Name = Form1
CommandButton
Name = Command1
Caption = "Hookit"
CommandButton
Name = Command2
Caption = "Unhook"

(*Note I would Place the command buttons about 2 or 3 dots down from the top, to see the output from the mouse wheel)

Here is the Form code:

Option Explicit

Private Sub Form_Load()
    'subclass the window [[b]Thank Hypetia[/b]]
    lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
    
    'Install system menu window procedure [[b]Thank strongm (+ the rest of code)[/b]]
    hWndSaved = Me.hWnd
    Hooked = False
End Sub

Private Sub Command1_Click()
    HookIt (Me.hWnd)
End Sub

Private Sub Command2_Click()
    Unhook (Me.hWnd)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Unhook (Me.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unhook (Me.hWnd)
End Sub

And the Module Code:

Option Explicit

[b]'---------- Mouse Wheel Declares -------- [Thank Hypetia][/b]
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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Const GWL_WNDPROC = (-4)
Public lpPrevWndProc As Long
Const WM_MOUSEWHEEL = &H20A
Const WHEEL_DELTA = 120
Dim Count As Integer

[b]'---------- Window Size Declares -------- [Thank strongm][/b]
' Some naughty globals
Public lpOldProc As Long
Public hWndSaved As Long
Public Hooked As Boolean

' Declarations for MINMAX stuff
Type POINTAPI
        x As Long
        y As Long
End Type

Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
End Type

Public Const WM_GETMINMAXINFO = &H24

' Declarations required for our subclassing

'***** The Following Declared Above ******
'* Public Const GWL_WNDPROC = (-4)
'* Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) 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
'* ' RtlMoveMemory is here aliased as CopyMemory in line with Bruce McKinney, who revealed
'* ' the function in the original 'HardCore Basic'. This is one hell of a handy function
'* Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


[b]'---------- Mouse Wheel Functions -------- [Thank Hypetia][/b]
Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_MOUSEWHEEL Then
        Dim Delta As Long
        Static Travel As Long
        Delta = HiWord(wParam)
        Travel = Travel + Delta
        MouseWheel Travel \ WHEEL_DELTA, LoWord(lParam), HiWord(lParam)
        Travel = Travel Mod WHEEL_DELTA
    End If
    WndProc = CallWindowProc(lpPrevWndProc, hWnd, Msg, wParam, lParam)
End Function

Sub MouseWheel(Travel As Integer, x As Long, y As Long)
    Count = Count + Travel
    Form1.Cls
    Form1.Print "Travel=" & Count, "X=" & x, "Y=" & y
End Sub

Function HiWord(DWord As Long) As Integer
    CopyMemory HiWord, ByVal VarPtr(DWord) + 2, 2
End Function

Function LoWord(DWord As Long) As Integer
    CopyMemory LoWord, DWord, 2
End Function

[b]'---------- Window Size Functions -------- [Thank strongm][/b]
Public Function WindowFunction(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim mmxMinMax As MINMAXINFO

    ' Is it the message we are interested in?
    If iMsg = WM_GETMINMAXINFO Then
        
        ' The big problem here is that lParam is a pointer to a MINMAXINFO
        ' structure, and VB does not know how to deal with such a pointer.
        ' Since we need access to that structure to be able to make changes we
        ' we need some method of dereferencing the pointer properly.
        ' The following does exactly that:
        CopyMemory mmxMinMax, ByVal lParam, Len(mmxMinMax)
        
        ' Change the min tracking size to something arbitary
        mmxMinMax.ptMinTrackSize.x = 400
        mmxMinMax.ptMinTrackSize.y = 400
        
        ' Now we need to make sure that the MINMAXINFO structure
        ' referenced by lParam contains our updated information.
        ' Copy the updated MINMAXINFO structure back to the
        ' over that referenced by lParam
        CopyMemory ByVal lParam, mmxMinMax, LenB(mmxMinMax)
        
        ' Now call the default window procedure...
        DefWindowProc hWnd, iMsg, wParam, lParam
        ' ...and then return 0& as we are supposed to if we deal with this message
        WindowFunction = 0&
        Exit Function
    End If

    ' OK, let Windows handle all other messages
    WindowFunction = CallWindowProc(lpOldProc, hWnd, iMsg, wParam, lParam)
End Function

Sub Unhook(hWnd As Long)
    If Hooked Then
        Call SetWindowLong(hWnd, GWL_WNDPROC, lpOldProc)
        Hooked = False
    End If
End Sub

Sub HookIt(hWnd As Long)
    If Not Hooked Then
        ' Warning! Make sure that procedure we are hooking in has the
        ' exact same parameters as the one being hooked, else we can
        ' kiss the application goodbye
        lpOldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowFunction)
        Hooked = True
    End If
End Sub

Thanks Again Guys...

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[CubeE101]

strongm,

what do you mean here...

Sub HookIt(hWnd As Long)
    If Not Hooked Then
[b]        ' Warning! Make sure that procedure we are hooking in has the
        ' exact same parameters as the one being hooked, else we can
        ' kiss the application goodbye[/b]
        lpOldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowFunction)
        Hooked = True
    End If
End Sub

It works OK if you place the HookIt in a command button, But when I placed it in Form_Load It killed it (and the IDE)

Does that have anything to do with your above comment?

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[CubeE101]

Actually... Trying that back in the test app, it worked fine... Must have something to do with one of the other 12 Modules in the project...

I guess I got go search & destroy some bugs now...

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[CubeE101]

OK... Found It...

In QueryUnload...

I originally had code to shut down another interface then End to kill any other active forms (before I made them children)...

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
...
  mqlStop
  Unhook (Me.hWnd)
  [b]End[/b]
End Sub

By just commenting the End call out...

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
...
  mqlStop
  Unhook (Me.hWnd)
  [b]'End[/b]
End Sub

The IDE stays open when the program closes...

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[Hypetia]

Cube101, thanks for pointing these threads. In the thread referring to the minimum size of a form, I changed the signature of the callback window procedure and declared lParam as RECT, just the right data type which I needed at that time.

This solves my purpose, but if you see thread711-607944, you will see that I have discouraged this technique myself because altering the signature of a standard function is not a good idea.

It makes it difficult to filter different messages in the same window procedure as the interpretation of lParam parameter varies with the particular message. This is exactly the case with Neseidus who wants to intercept WM_MOUSEWHEEL and WM_MOVING in the same window procedure.

So the best way is to leave the signature of window procedure in its original and generic form with lParam declared as Long.

I discussed this issue in detail in thread711-607944 and also corrected my original code in order to cast a RECT structure from a Long.

neseidus, your code is almost correct but you only need to modify the CopyMemory call a little bit.

Instead of this;
[tt]CopyMemory R, lParam, Len(lParam)[/tt]

use this;
[tt]CopyMemory R, ByVal lParam, Len(R)[/tt]

This is exactly the same code as I used in the above-mentioned thread, for casting a RECT from a Long. If you want to write back the RECT structure after some modification, use the CopyMemory function again swapping the first two arguments.
[tt]CopyMemory ByVal lParam, R, Len(R)[/tt]

This again, is mentioned in the said thread.

Hope it makes some sense.

 

[neseidus]

Thanks a lot

I also had the problem that my IDE was closing whenever my program closed so thanks for solving that for me too!