Private Sub Timer1_Timer()
If Form1.ScaleWidth <> 200 Or Form1.scaleheigth <> 400 Then
' твои размеры
End If
End Sub

Ответить

Ответить

|¤™•†Raven†•™¤I, ты не прав. Делать надо так:

Private Sub Form_Resize()

If Me.WindowState<>vbMinimized Then

If Me.Width<300 Then Me.Width=300

If Me.Width>500 Then Me.Width=500

If Me.Height<200 Then

If Me.Height>400 Then Me.Height=400

End If

End Sub

А вообще же, если очень крутой и не лень использовать API, можно делать так:

В форме написать:

Private Const GWL_WNDPROC = (-4)

Private Sub Form_Load()

OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)

Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWindowProc)

End Sub

А в модуле:

Public OldWindowProc As Long ' Original window proc

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen 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

Public Const WM_GETMINMAXINFO = &H24

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 Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long

If Msg = WM_GETMINMAXINFO Then

Dim MinMax As MINMAXINFO

CopyMemory MinMax, ByVal lp, Len(MinMax)

MinMax.ptMinTrackSize.x = 3975 \ Screen.TwipsPerPixelX

MinMax.ptMinTrackSize.y = 1740 \ Screen.TwipsPerPixelY

MinMax.ptMaxTrackSize.x = Screen.Width \ Screen.TwipsPerPixelX \ 2

MinMax.ptMaxTrackSize.y = 3480 \ Screen.TwipsPerPixelY

CopyMemory ByVal lp, MinMax, Len(MinMax)

SubClass1_WndMessage = 1

Exit Function

End If

SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)

End Function

Тогда рамка растягивания (уж не знаю, как ее еще назвать) не будет даже выходить за края выбранного размера из-за того, что процедура окна, обрабатывая сообщение ресайза для этого окна не будет вызывать для этого стандартную оконную функцию, если размер окна больше (меньше) заданного....

Ответить

|¤™•†Raven†•™¤I, ты не прав. Делать надо так:

Private Sub Form_Resize()

If Me.WindowState<>vbMinimized Then

If Me.Width<300 Then Me.Width=300

If Me.Width>500 Then Me.Width=500

If Me.Height<200 Then

If Me.Height>400 Then Me.Height=400

End If

End Sub

А вообще же, если очень крутой и не лень использовать API, можно делать так:

В форме написать:

Private Const GWL_WNDPROC = (-4)

Private Sub Form_Load()

OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)

Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)

End Sub

Private Sub Form_Unload(Cancel As Integer)

Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWindowProc)

End Sub

А в модуле:

Public OldWindowProc As Long ' Original window proc

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen 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

Public Const WM_GETMINMAXINFO = &H24

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 Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long

If Msg = WM_GETMINMAXINFO Then

Dim MinMax As MINMAXINFO

CopyMemory MinMax, ByVal lp, Len(MinMax)

MinMax.ptMinTrackSize.x = 3975 \ Screen.TwipsPerPixelX

MinMax.ptMinTrackSize.y = 1740 \ Screen.TwipsPerPixelY

MinMax.ptMaxTrackSize.x = Screen.Width \ Screen.TwipsPerPixelX \ 2

MinMax.ptMaxTrackSize.y = 3480 \ Screen.TwipsPerPixelY

CopyMemory ByVal lp, MinMax, Len(MinMax)

SubClass1_WndMessage = 1

Exit Function

End If

SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)

End Function

Тогда рамка растягивания (уж не знаю, как ее еще назвать) не будет даже выходить за края выбранного размера из-за того, что процедура окна, обрабатывая сообщение ресайза для этого окна не будет вызывать для этого стандартную оконную функцию, если размер окна больше (меньше) заданного....

Ответить

Все равно, то будет работать пусть и не красиво, но будет

Ответить

То, который с API - это то, что мне надо. Спасибо.

Ответить