Form moving

[Bjarke.ip]

How do I stop a user from moving a form outside the screen border, but still giving them the option to move the form within the screenborders?

[WP]

I know, its not the best way to do this with a timer, but there is no event witch is activated by moving the form .

'Timer1.Interval = 100 (0.1 sec)
Private Sub Timer1_Timer()
With Form1
    If .Top < 0 Then .Top = 0
    If .Left < 0 Then .Left = 0
    If .Top > Screen.Height - .Height Then .Top = Screen.Height - .Height
    If .Left > Screen.Width - .Width Then .Left = Screen.Width - .Width
End With
End Sub

Hope this helped you,

WP

The simplest way is to add a timer that checks where the form is. If it's outside the screen, it puts it back. Example:

Private Sub Timer1_Timer ()
    If Top < 0 Then Top = 0
    If Top > Screen.Height - Height Then Top = Screen.Height - Height
    If Left < 0 Then Left = 0
    If Left > Screen.Width - Width Then Left = Screen.Width - Width
End Sub

Little harder way is to make a window that has no caption bar, insert a label that works like the caption and has code like following:

Dim MyX As Single
Dim MyY As Single

Private Sub Label1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> 1 Then Exit Sub
    MyX = X
    MyY = Y
End Sub

Private Sub Label1_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> 1 Then Exit Sub
    Dim NewX As Single
    Dim NewY As Single
    NewX = Left - X + MyX
    NewY = Top - Y + MyY
    If NewY < 0 Then NewY = 0
    If NewY > Screen.Height - Height Then NewY = Screen.Height - Height
    If NewX < 0 Then NewX = 0
    If NewX > Screen.Width - Width Then NewX = Screen.Width - Width
    Move NewX, NewY
End Sub

Hope I didn't make any typos or thought wrong...Anyway, hope this is what you look for. There is maybe an API way too, but these are maybe easier to understand.

[Edited by MerryVIP on 10-30-2000 at 05:24 AM]

[WP]

Private Sub Timer1_Timer ()
    If Top < 0 Then Top = 0
    If Top > Screen.Height - Height Then Top = Screen.Height - Height
    If Left < 0 Then Left = 0
    If Left > Screen.Width - Width Then Left = Screen.Width - Width
End Sub

I just wrote the same thing dumpy!

WP

You replied while I was writing!

And I don't want to remove it

Try this:

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type


Private Sub Timer1_Timer()

    Dim tRect As RECT
    If Me.Left < 700 Then Me.Left = 0
    If Me.Left > 7500 Then Me.Left = Screen.Width - Width
    If Me.Top < 700 Then Me.Top = 0
    If Me.Top > 7500 Then
        Call GetWindowRect(FindWindowEx(0&, 0&, "Shell_TrayWnd", vbNullString), tRect)
        Top = ScaleY(tRect.Top, vbPixels, vbTwips) - Height
        Exit Sub
    End If

End Sub

Or subclass the WM_MOVING message.

Add the following to a Module

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)
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
Const GWL_WNDPROC = (-4)
Const WM_MOVING = &H216

Global WndProcOld As Long

Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    If wMsg - WM_MOVING Then
        If Form1.Top < 0 Then Form1.Top = 0
        If Form1.Top > Screen.Height - Form1.Height Then Form1.Top = Screen.Height - Form1.Height
        If Form1.Left < 0 Then Form1.Left = 0
        If Form1.Left > Screen.Width - Form1.Width Then Form1.Left = Screen.Width - Form1.Width
    End If
  
    WindProc = CallWindowProc(WndProcOld&, hwnd&, wMsg&, wParam&, lParam&)
    
End Function

Sub SubClassWnd(hwnd As Long)
    WndProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindProc)
End Sub

Sub UnSubclassWnd(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, WndProcOld&
    WndProcOld& = 0
End Sub

Code for a Form

Private Sub Form_Load()
    SubClassWnd hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnSubclassWnd hwnd
End Sub