Prev: VB.NET and x64 Assembler issue
Next: Print the value in a varial
From: Martin Trump on 31 Jan 2010 12:13
Hi

I want to have a form resizeable but with a minimum width. Here's the
essence of my code.

Option Explicit
Dim frmwidth As Long

Private Sub Form_Load()
frmwidth = Me.Width
End Sub

Private Sub Form_Resize()
If Me.Width < frmwidth Then
Me.Width = frmwidth
End If
End Sub

That works but the form flashes badly when attempting to go below the
original size. Is there a way to do that neatly? TIA.


Martin
From: Mike Williams on 31 Jan 2010 17:30
On 31 Jan, 17:13, Martin Trump <mar...(a)wmeadow.demon.co.uk> wrote:

> I want to have a form resizeable but with a minimum
> width. Here's the essence of my code {snipped].
> That works but the form flashes badly when attempting
> to go below the original size. Is there a way to do
> that neatly? TIA.

Here's one way. It uses subclassing, which can crash your app when
running in the IDE if you have code errors while testing your program,
or if you stop it in the VB IDE using the Run / End menu, so until you
have completed testing your program and are ready to compile it is
best to comment out the RestrictResize line in the Form Load event.
(There are ways to do subclassing where you don't need to worry about
those things and you'll find some examples on the web, but this
simpler method will probably be okay for you. There are two blocks of
code. Paste one into a Form and the other into a standard code module:

Mike

' ***** START OF FORM CODE *****
Option Explicit
Private Sub Form_Load()
' params are xMin, xMax, yMin, yMax
' set mins to zero if you don't want to restrict min size
' set maxs to -1 if you don't want to restrict max size
' (In this specific example, we restrict the width to
' a minimum of 300 pixels and we leave the others alone
RestrictSize Me.hwnd, 300, -1, 0, -1
End Sub

Private Sub Form_Unload(Cancel As Integer)
FreeSize Me.hwnd
End Sub
' ***** END OF FORM CODE *****
'
' ***** START OF MODULE CODE *****
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, ByVal Length As Long)
Private 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
Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom 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 DefWindowProc As Long
Private xMin As Long, xMax As Long
Private yMin As Long, yMax As Long
Private Const WM_GETMINMAXINFO = &H24
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_DESTROY = &H2

Public Sub FreeSize(hwnd As Long)
If DefWindowProc Then
SetWindowLong hwnd, GWL_WNDPROC, DefWindowProc
DefWindowProc = 0
End If
End Sub

Public Sub RestrictSize(hwnd As Long, minWide As Long, _
maxWide As Long, minHigh As Long, maxHigh As Long)
xMin = minWide: xMax = maxWide
yMin = minHigh: yMax = maxHigh
DefWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub

Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MinMax As MINMAXINFO
Select Case uMsg
Case WM_DESTROY:
If DefWindowProc <> 0 Then
Call FreeSize(Form1.hwnd)
End If
Case WM_GETMINMAXINFO
CopyMemory MinMax, ByVal lParam, Len(MinMax)
MinMax.ptMinTrackSize.x = xMin
MinMax.ptMinTrackSize.y = yMin
If xMax <> -1 Then
MinMax.ptMaxTrackSize.x = xMax
End If
If yMax <> -1 Then
MinMax.ptMaxTrackSize.y = yMax
End If
CopyMemory ByVal lParam, MinMax, Len(MinMax)
Case Else
WindowProc = CallWindowProc(DefWindowProc, hwnd, _
uMsg, wParam, lParam)
End Select
End Function
' ***** END OF MODULE CODE *****
From: Martin Trump on 4 Feb 2010 11:33
Mike

Many thanks for your response, it'll take a me while to get my mind
round it.

Regards

Martin
 | 
Pages: 1
Prev: VB.NET and x64 Assembler issue
Next: Print the value in a varial