Drag form by any "gray" space rather than just the title-bar

[Elroy]

A special thanks to LaVolpe for coming up with the best idea on doing this.

Sure, most of us know how to drag a form around by the form's own "gray" space. But what if we also want labels to drag it, and we also want any containers to work as well. Sure, we don't want Buttons, TextBoxes, ComboBoxes, and other "active" controls to work, but we do want the inactive controls to work. That's where these routines come to the rescue.

Let me also say that this may not be a perfect solution for everyone, especially if you use labels and containers in a more "active" way than I do. But I thought it was pretty cool, so I posted it.

Also, just as an FYI, it also works with the SSTab container, which I tend to use often.

Start by looking at the code in Form1 to see how to use it. It should be fairly self-explanatory. The whole objective was to make the amount of code in your form be at a minimum. The other modules should just be "drop ins" for you.

Sure, we could do this by monitoring the mouse-events of all the places we'd like to drag, but these procedures hopefully makes the whole thing easier. Also, my objective was to do all of this without sub-classing so we could still use all the glory of the IDE. Labels in control arrays don't slow it down either.

Enjoy,
Elroy

[Elroy]

And here's a related "drop in" module that will guarantee that small monitors don't resize your large forms. Specifically, read the comments on SubClassForFixedSize, and focus on that procedure as well as the UnSubClassForFixedSize procedure. It's designed to be dropped into a BAS module.

Enjoy,
Elroy

Option Explicit
'
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_GETMINMAXINFO As Long = &H24
'
Private Type POINTAPI
    x As Long
    y As Long
End Type
'
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
'
Private defWindowProc As New Collection
Private hWndSaved As New Collection
Private StartupWidth As New Collection
Private StartupHeight As New Collection
'

Public Sub SubClassForFixedSize(frm As Form)
    '
    ' Do this in the form LOAD event.  Be sure to call UnSubClassForFixedSize if this is used.
    '
    ' NOTE: If done in the form LOAD event, the form will NOT have been resized from a smaller monitor.
    '       If done in form ACTIVATE or anywhere else, we're too late, and the form will have been resized.
    '
    ' ALSO: If you're in the IDE, and the monitors aren't big enough, do NOT open the form in design mode.
    '       So long as you don't open it, everything is fine, although you can NOT compile in the IDE.
    '       If you're compiling without large enough monitors, you MUST do a command line compile.
    '
    ' This can simultaneously be used by as many forms as will need it.
    '
    Dim b As Boolean
    Dim PelWidth As Long
    Dim PelHeight As Long
    '
    ' The following allows us to debug in IDE when our monitors are big enough to deal with our large forms.
    If (frm.Height <= ScreenHeight) And (frm.Width <= ScreenWidth) And (Not CompiledProgram) Then Exit Sub
    '
    '
    If Not FormIsOnList(frm.hWnd) Then ' Make sure it hasn't already been done.
        PelWidth = frm.Width \ TwipsPerPixelX
        PelHeight = frm.Height \ TwipsPerPixelY
        '
        hWndSaved.Add frm.hWnd, Format$(frm.hWnd)
        StartupWidth.Add PelWidth, Format$(frm.hWnd)
        StartupHeight.Add PelHeight, Format$(frm.hWnd)
        defWindowProc.Add SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf WindowProc), Format$(frm.hWnd)
    End If
End Sub

Public Sub UnSubClassForFixedSize(frm As Form)
    ' This MUST be done in the form unload event!!!!!!!!!
    '
    If FormIsOnList(frm.hWnd) Then ' Make sure we don't try and do it more than once.
        SetWindowLong hWndSaved.Item(Format$(frm.hWnd)), GWL_WNDPROC, defWindowProc.Item(Format$(frm.hWnd))
        defWindowProc.Remove Format$(frm.hWnd)
        hWndSaved.Remove Format$(frm.hWnd)
        StartupWidth.Remove Format$(frm.hWnd)
        StartupHeight.Remove Format$(frm.hWnd)
    End If
End Sub

Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim MMI As MINMAXINFO
    '
    On Error Resume Next ' This will protect us from form somehow not being on the list.
        If uMsg = WM_GETMINMAXINFO Then
            ' Force the form to stay at initial size.
            CopyMemory MMI, ByVal lParam, LenB(MMI)
            MMI.ptMinTrackSize.x = StartupWidth.Item(Format$(hWnd))
            MMI.ptMinTrackSize.y = StartupHeight.Item(Format$(hWnd))
            MMI.ptMaxTrackSize.x = StartupWidth.Item(Format$(hWnd))
            MMI.ptMaxTrackSize.y = StartupHeight.Item(Format$(hWnd))
            CopyMemory ByVal lParam, MMI, LenB(MMI)
            WindowProc = 0 ' If we process the message, we must return 0.
        Else
            WindowProc = CallWindowProc(defWindowProc.Item(Format$(hWnd)), hWnd, uMsg, wParam, lParam)
        End If
    On Error GoTo 0
End Function

Private Function FormIsOnList(hWnd As Long) As Boolean
    ' Used only internally to determine if a form has been subclassed.
    Dim l As Long
    '
    On Error Resume Next
        l = hWndSaved.Item(Format$(hWnd)) ' This will cause error and leave l=0 if no item in collection.
    On Error GoTo 0
    FormIsOnList = l <> 0
End Function

Private Function CompiledProgram() As Boolean
    ' IDE bInIde bIsIde IsIde InIde.
    On Error Resume Next
    Debug.Print 1 / 0
        CompiledProgram = Err = 0
    On Error GoTo 0
End Function

Private Function ScreenWidth()
    ' This works even on Tablet PC.  The problem is: when the tablet screen is rotated, the "Screen" object of VB doesn't pick it up.
    Dim Pixels As Long
    Const SM_CXSCREEN = 0
    '
    Pixels = GetSystemMetrics(SM_CXSCREEN)
    ScreenWidth = Pixels * TwipsPerPixelX
End Function

Private Function ScreenHeight(Optional bSubtractTaskbar As Boolean = False)
    ' This works even on Tablet PC.  The problem is: when the tablet screen is rotated, the "Screen" object of VB doesn't pick it up.
    Dim Pixels As Long
    Const SM_CYSCREEN = 1
    '
    Pixels = GetSystemMetrics(SM_CYSCREEN)
    If bSubtractTaskbar Then
        ' The taskbar is typically 30 pixels or 450 twips, or, at least, this is the assumption made here.
        ' It can actually be multiples of this, or possibly moved to the side or top.
        ' This procedure does not account for these possibilities.
        ScreenHeight = (Pixels - 30) * TwipsPerPixelY
    Else
        ScreenHeight = Pixels * TwipsPerPixelY
    End If
End Function

Private Function TwipsPerPixelX() As Single
    ' In a system with multiple display monitors, this value is the same for all monitors.
    ' It works MUCH better than Screen.TwipsPerPixelX as it recognizes portrait monitors.
    Dim hdc As Long
    Dim lPixelsPerInch As Long
    Const LOGPIXELSX = 88        '  Logical pixels/inch in X
    Const POINTS_PER_INCH As Long = 72 ' A point is defined as 1/72 inches.
    Const TWIPS_PER_POINT As Long = 20 ' Also, by definition.
    '
    hdc = GetDC(0)
    lPixelsPerInch = GetDeviceCaps(hdc, LOGPIXELSX)
    ReleaseDC 0, hdc
    TwipsPerPixelX = TWIPS_PER_POINT * (POINTS_PER_INCH / lPixelsPerInch) ' Cancel units to see it.
End Function

Private Function TwipsPerPixelY() As Single
    ' In a system with multiple display monitors, this value is the same for all monitors.
    ' It works MUCH better than Screen.TwipsPerPixelY as it recognizes portrait monitors.
    Dim hdc As Long
    Dim lPixelsPerInch As Long
    Const LOGPIXELSY = 90        '  Logical pixels/inch in Y
    Const POINTS_PER_INCH As Long = 72 ' A point is defined as 1/72 inches.
    Const TWIPS_PER_POINT As Long = 20 ' Also, by definition.
    '
    hdc = GetDC(0)
    lPixelsPerInch = GetDeviceCaps(hdc, LOGPIXELSY)
    ReleaseDC 0, hdc
    TwipsPerPixelY = TWIPS_PER_POINT * (POINTS_PER_INCH / lPixelsPerInch) ' Cancel units to see it.
End Function

[LaVolpe]

Elroy, couple thoughts

1. Should someone want their windowless control to be clickable, they could always place it higher in the ZOrder after your code has added the image control.

2. To test for a container, and if successful, you are creating then removing a control. Since you are already creating an img control for the form, you can place that on the form after all controls have been dealt with. Then instead of creating a line control for the test, simply try to set the img.Container to the control being tested. If no error then the ctrl accepted the img. After all controls are checked, set the img.Container to the Form and position/size. This would prevent having to create/destroy additional controls unnecessarily.

3. Not sure why setting and resetting twips scalemode is necessary? For a form with lots of controls; that's a lot of code being executed maybe unnecessarily. I'm assuming you are doing this to set the image's Width/Height property for containers like Frames/SSTab. Maybe in this case, only when the control has no scalemode property, set the parent container scalemode to twips, set image dimensions, then restore the scalemode. In the rare case where more than 1 control without scalemode is nested in like-controls, a recursive loop may be needed to find the first outer container with a scalemode?

[Elroy]

Elroy, couple thoughts

1. Should someone want their windowless control to be clickable, they could always place it higher in the ZOrder after your code has added the image control.

2. To test for a container, and if successful, you are creating then removing a control. Since you are already creating an img control for the form, you can place that on the form after all controls have been dealt with. Then instead of creating a line control for the test, simply try to set the img.Container to the control being tested. If no error then the ctrl accepted the img. After all controls are checked, set the img.Container to the Form and position/size. This would prevent having to create/destroy additional controls unnecessarily.

3. Not sure why setting and resetting twips scalemode is necessary? For a form with lots of controls; that's a lot of code being executed maybe unnecessarily. I'm assuming you are doing this to set the image's Width/Height property for containers like Frames/SSTab. Maybe in this case, only when the control has no scalemode property, set the parent container scalemode to twips, set image dimensions, then restore the scalemode. In the rare case where more than 1 control without scalemode is nested in like-controls, a recursive loop may be needed to find the first outer container with a scalemode?

Hi LaVolpe,

Yeah, #1 and #2 are good ideas. Regarding #2, I just copied and dropped in that code from my larger project. But you're right. It could be cleaned up (but it's not technically "broken"). Regarding #1, I'm thinking the cleanest way to do that would be to add an optional argument to the "Friend Sub Resize" procedure possibly named something like "bLeaveZorderAlone". That way, it would be set upon first initialization, and then left alone after that (if you so chose).

Regarding #3, yeah, I was initially doing it on the fly, and then I realized I wasn't covering all the bases (as you suggest). That's why I resorted to a "do it for everything" approach. I've already tested on a very complex form, and there doesn't seem to be any delay, so I think I'm probably okay on that one. It's the "container without ScaleMode on a container with ScaleMode on the form" that gets complicated. Rather than think through all of that, I just took my comprehensive approach.


I've already made more changes to this thing, such as a ParamArray on the "Friend Sub Setup" call. This ParamArray allows you to specify containers to exclude from all this. That's a particular need I've got.

If it catches on, I'll probably make occasional updates.

And hey, thanks for the suggestions and taking a look at it.

All The Best,
Elroy

[LaVolpe]

Rather than think through all of that, I just took my comprehensive approach.

Been there, done that.

Regarding the looping, it just appears you are looping thru every control twice. Once when setting the scalemode and again during the setup routine. Removing the scalemode is a bit more efficient, but at the cost of arrays. I looked at that process and kinda cringed a bit.

I doubt this will ever come into play, but I don't see a workaround unless you can build off an image array... You are creating one image control per form, per container. VB has a limit of how many controls can be used and arrays are somewhat excluded. I don't recall if those created with Controls.Add() count towards that limit or not? Like I said, it is unlikely this scenario would occur unless the form already has a ton of controls, many of which are containers.

Edited: Though I've seen some weird stuff in my days, like a 12x12 grid composed of picturebox controls when a label or image control would have sufficed and used far less resources.

[Elroy]

build off an image array

Yeah, I thought of that too, but then that makes the usage in the form a bit more complex. I just really liked how easy and clean it was to use. It'd be nice if the Controls.Add allowed you to specify an index for creation of control arrays.

Also, I agree my management of ScaleMode is a bit rough (such as not even doing a Redim Preserve when I gathered them all), but I knew it'd all be thrown out in just a second.

Regarding a large number of containers, that could certainly be a problem. However, I will put an update out in a few days whereby you can specify a container exclusion list. That should solve that problem.

I actually just arrived on a gig for two weeks, so I may be a bit scarce. Although I love taking breaks and checking out VBForums.