ennixo
asked on
Resize, lock at minimum size
how to disable resize in order to have a minimum size for the window, just like paint.exe, without flashing ?
i'm in VB6.
i'm in VB6.
Taken from the above link:
'===============Bas module code============
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 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 Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Const GWL_WNDPROC = (-4)
Const WM_GETMINMAXINFO = &H24
Public OldProc As Long
Public MinWidth As Long
Public MinHeight As Long
Dim MMinfo As MINMAXINFO
Public Function WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case wMsg
Case WM_GETMINMAXINFO
CopyMemory MMinfo, ByVal lParam, LenB(MMinfo)
' Max/Min size when tracking
MMinfo.ptMinTrackSize.x = MinWidth
MMinfo.ptMinTrackSize.y = MinHeight
' MMinfo.ptMaxTrackSize.x = MaxWidth
' MMinfo.ptMaxTrackSize.y = MaxHeight
CopyMemory ByVal lParam, MMinfo, LenB(MMinfo)
Exit Function
End Select
WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
End Function
'===========Form code===========
Private Sub Form_Load()
MinWidth = 128
MinHeight = 128
Me.AutoRedraw = True
Me.Print "Minimum size of this form" & vbCrLf & "is limited to 128x128 pixels"
OldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(hwnd, GWL_WNDPROC, OldProc)
End Sub
'========================= ========
Note: this code use subclassing, so don't stop it with IDE stop button, use form [x] button to close form.
Good Luck
-Brian
'===============Bas module code============
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 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 Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Const GWL_WNDPROC = (-4)
Const WM_GETMINMAXINFO = &H24
Public OldProc As Long
Public MinWidth As Long
Public MinHeight As Long
Dim MMinfo As MINMAXINFO
Public Function WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case wMsg
Case WM_GETMINMAXINFO
CopyMemory MMinfo, ByVal lParam, LenB(MMinfo)
' Max/Min size when tracking
MMinfo.ptMinTrackSize.x = MinWidth
MMinfo.ptMinTrackSize.y = MinHeight
' MMinfo.ptMaxTrackSize.x = MaxWidth
' MMinfo.ptMaxTrackSize.y = MaxHeight
CopyMemory ByVal lParam, MMinfo, LenB(MMinfo)
Exit Function
End Select
WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
End Function
'===========Form code===========
Private Sub Form_Load()
MinWidth = 128
MinHeight = 128
Me.AutoRedraw = True
Me.Print "Minimum size of this form" & vbCrLf & "is limited to 128x128 pixels"
OldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(hwnd, GWL_WNDPROC, OldProc)
End Sub
'=========================
Note: this code use subclassing, so don't stop it with IDE stop button, use form [x] button to close form.
Good Luck
-Brian
I think you can use the Resize event, have a function there to test if the height and width is greater then your minimum size, otherwise set it to the minimum values, something like this:
private sub form_resize()
if me.width<MINIMUM_WIDTH then
me.width=MINIMUM_WIDTH
end if
'same to the form height
end sub
private sub form_resize()
if me.width<MINIMUM_WIDTH then
me.width=MINIMUM_WIDTH
end if
'same to the form height
end sub
ChenChen: The flicker he is refering to in his question is because he is doing it like that.
When you resize like that you will see a flicker, subclassing allows the resize event to not be passed to the form if the dimensions are smaller than specified. So therefore, no flicker.
-Brian
When you resize like that you will see a flicker, subclassing allows the resize event to not be passed to the form if the dimensions are smaller than specified. So therefore, no flicker.
-Brian
ASKER
BrianGEFF719: your code works great but :
- if i add "End" on query unload it crashes and i must add it to end the app if other windows are opened.
- i removed AutoRedraw = true because i draw everything with api, so this is faster a lot ! is it good or bad ?
- if i add "End" on query unload it crashes and i must add it to end the app if other windows are opened.
- i removed AutoRedraw = true because i draw everything with api, so this is faster a lot ! is it good or bad ?
ennixo,
Don't use End until you've done the SetWindowLong in the Form_Unload() event. End will work just as well if you put it in Form_Unload as in Form_QueryUnload.
David
Don't use End until you've done the SetWindowLong in the Form_Unload() event. End will work just as well if you put it in Form_Unload as in Form_QueryUnload.
David
ASKER
in my Form_QueryUnload sub i added End after the Call SetWindowLong(Me.hWnd, GWL_WNDPROC, OldProc) and it crashes...
if i comment the End, it doesn't crashes...
(it's not really a crash, it's just that the VB-IDE is closed... is it normal ? is it because in "debug mode" the subclass is made by VB ?)
is there another way ?
if i comment the End, it doesn't crashes...
(it's not really a crash, it's just that the VB-IDE is closed... is it normal ? is it because in "debug mode" the subclass is made by VB ?)
is there another way ?
ennixo: This is normal, subclassed programs FUNCTION WEIRD in the IDE.
Always make sure to close the program with the "X" and not "End"
-Brian
Always make sure to close the program with the "X" and not "End"
-Brian
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
If you are using End because your application has other windows open, do something like this rather than using End:
Dim frm As Form
For Each frm In Forms
If Not frm Is Me Then Unload frm
Next frm
That way, when this form unloads, it will be the last one, and the app will exit.
Dim frm As Form
For Each frm In Forms
If Not frm Is Me Then Unload frm
Next frm
That way, when this form unloads, it will be the last one, and the app will exit.
Hello, i have a question, what if i have 2 forms, im limiting the size, and i want the sizes of them both to be diffrent. There child mdi forms.
-Brian