MDI

[Vladimir!]

Здравствуйте! Подскажите, как можно запретить изменение размеров MDI формы путем перетаскивания ее краев?

[GSerg]

А каким способом разрешить?

[d3drm]

А каким способом разрешить?

по умолчанию.

один из возможных выходов, но тупой, при form_resize обратно устанавливать нужные размеры формы...

[GSerg]

Лучше уж тогда в WM_GETMINMAXINFO писать одни и те же числа для минимума и максимума...

[vvs_adm]

один из возможных выходов, но тупой, при form_resize обратно устанавливать нужные размеры формы...

К сожалению он не только тупой, но и совершенно неприменимый Это первое, что пришло когда-то мне в голову, но пока ты мышь не отпустишь, контур формы будет тащиться за ней все равно, и только после отпускания размер тут же восстановится. Короче, мягко говоря - кошмар. А вот WM_GETMINMAXINFO - в самый раз.

[d3drm]

я про это и говорил. тупой, но рабочий... сам бы я его ессно не юзал бы...

[Vladimir!]

Не знаю почему, но WM_GETMINMAXINFO работает у меня со всеми формами, кроме MDI. Я что-то неправильно делаю?

Код в форме:

Option Explicit

Private Sub Form_Load()
'Save handle to the form.
gHW = Me.hwnd
'Begin subclassing.
Hook
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Stop subclassing.
Unhook
End Sub

В модуле:

Option Explicit

Private Const GWL_WNDPROC = -4
Private Const WM _ GETMINMAXINFO = &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

Global lpPrevWndProc As Long
Global gHW As Long

Private 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
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 Declare Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias _
"RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, _
ByVal cbCopy As Long)
Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias _
"RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, _
ByVal cbCopy As Long)

Public Sub Hook()
'Start subclassing.
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub Unhook()
Dim temp As Long
'Cease subclassing.
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MinMax As MINMAXINFO

'Check for request for min/max window sizes.
If uMsg = WM _ GETMINMAXINFO Then
'Retrieve default MinMax settings
CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)

'Specify new minimum size for window.
MinMax.ptMinTrackSize.x = 200
MinMax.ptMinTrackSize.y = 200

'Specify new maximum size for window.
MinMax.ptMaxTrackSize.x = 500
MinMax.ptMaxTrackSize.y = 500

'Copy local structure back.
CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)

WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, _
wParam, lParam)
End If
End Function