Сообщение WM_EXITSIZEMOVE

Сообщение WM_EXITSIZEMOVE посылается окну один раз при щелчке мышью на заголовке формы или при изменении размеров формы через границы формы, а также когда окно передает сообщение WM_SYSCOMMAND функции DefWindowProc и параметр wParam сообщения имеет значение SC_MOVE или SC_SIZE. Окно получает данное сообщение через функцию обратного вызова WindowProc

Возвращаемое значение

Если приложение обработало это сообщение, то возвращается 0

Параметры

Сообщение не имеет параметров

Пример

' Создаем эффект приклеивания окна
' при перемещении окна или изменении его размеров
' Поместите код в модуль,
' т.к. используется функция обратного вызова
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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_LBUTTONUP = &H202
Public Const WM_EXITSIZEMOVE = &H232

Dim PrevProc As Long

Public Sub HookForm(Button As Long)
    PrevProc = SetWindowLong(Button, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHookForm(Button As Long)
    SetWindowLong Button, GWL_WNDPROC, PrevProc
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 ' Скроллируем форму. wParam - величина перемещения
   If uMsg = WM_LBUTTONUP Or uMsg = WM_EXITSIZEMOVE Then  ' кнопка была отпущена
        Form1.Stick
    End If

    WindowProc = CallWindowProc( _
        PrevProc, hwnd, uMsg, wParam, lParam)
End Function

' Поместите код для Form1
Private Sub Form_Load()
    HookForm Me.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHookForm Me.hwnd
End Sub

Public Sub Stick()
' Чтобы избежать ошибки, если окно развернуто
    If Me.WindowState = vbMaximized Then Exit Sub

        If Me.Left <= 1400 Then
            Me.Left = 0
        ElseIf Me.Left >= (Screen.Width - Me.Width) - 1400 Then
            ' Перемещаем правый край формы на правый край экрана
            Me.Left = Screen.Width - Me.Width
        End If

        If Me.Top <= 1400 Then Me.Top = 0 ' приклеиваем наверх

        If (Screen.Height - Me.Top) - 1400 <= Me.Height Then ' приклеиваем к низу экрана
            Me.Top = Screen.Height - Me.Height
    End If

End Sub

Категория