Docking forms

[VB4Eva]

I'm using this code which allows me to dock a form. However what i need is a way to when the form is docked to either side of the screen the form will adopt the height of the screen and when i move to either the top or the bottom of the screen it addopts the width. Does anyone know how i would intergrate this?

'Form declaration section
Dim Xs As Integer               'Change in X
Dim Ys As Integer               'Change in Y
Dim IsBeingDragged As Boolean   'Flag if the form is being dragged
Dim DockScale As Integer        'Scale by which the form docks itself to screen
 
Private Sub Form_Load()
'set form docking scale (change it according to your needs)
DockScale = 200
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'set flag to true
IsBeingDragged = True
'get X Change and Y Change
Xs = x
Ys = y
End Sub
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If IsBeingDragged = True And Button = vbLeftButton Then
    'if the drag flag is true and left mouse button is pressed...
    
    'set Left side  docking
    If Form1.Left + (x - Xs) < DockScale Then
        Form1.Left = 0
        Exit Sub
    End If
    'set Top side docking
    If Form1.Top + (y - Ys) < DockScale Then
        Form1.Top = 0
        Exit Sub
    End If
    
    'set right side docking
    If Form1.Left + (x - Xs) + Form1.Width > (Screen.Width - DockScale) Then
        Form1.Left = Screen.Width - Form1.Width
        Exit Sub
    End If
    
    'set bottom side docking
    If Form1.Top + (y - Ys) + Form1.Height > (Screen.Height - DockScale) Then
        Form1.Top = Screen.Height - Form1.Height
        Exit Sub
    End If
   
    'move the form finally
    Form1.Left = Form1.Left + (x - Xs)
    Form1.Top = Form1.Top + (y - Ys)
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    'set drag flag to false
    IsBeingDragged = False
End Sub

Regards


Carl

[guyvdn]

Fun thing to do and I got it working

Code can be cleaned up maybe but it's 2AM over here so I am going to bed.

'Form declaration section
Dim Xs As Integer               'Change in X
Dim Ys As Integer               'Change in Y
Dim myHeight As Integer
Dim myWidth As Integer
Dim IsBeingDragged As Boolean   'Flag if the form is being dragged
Dim DockScale As Integer        'Scale by which the form docks itself to screen
Dim blnDocked As Boolean
Dim lngTaskBarHeight As Long
 
Const ABS_AUTOHIDE = &H1
Const ABS_ONTOP = &H2
Const ABM_GETSTATE = &H4
Const ABM_GETTASKBARPOS = &H5
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type APPBARDATA
    cbSize As Long
    hwnd As Long
    uCallbackMessage As Long
    uEdge As Long
    rc As RECT
    lParam As Long '  message specific
End Type
Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
 
Private Sub Form_Load()
    'set form docking scale (change it according to your needs)
    DockScale = 200
    myHeight = Me.Height
    myWidth = Me.Width
    blnDocked = False
    
    'Get taskbar height
    Dim ABD As APPBARDATA, Ret As Long
    SHAppBarMessage ABM_GETTASKBARPOS, ABD
    lngTaskBarHeight = ABD.rc.Top * Screen.TwipsPerPixelY
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    'set flag to true
    IsBeingDragged = True
    'get X Change and Y Change
    Xs = x
    Ys = y
End Sub
 
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
 
    If IsBeingDragged = True And Button = vbLeftButton Then
        'if the drag flag is true and left mouse button is pressed...
        
        If blnDocked Then
        
            'Allow undocking
            If ((Form1.Left = 0 And Form1.Height = lngTaskBarHeight) And (Form1.Left + (x - Xs) > DockScale)) Or _
               ((Form1.Top = 0 And Form1.Width = Screen.Width) And (Form1.Top + (y - Ys) > DockScale)) Or _
               ((Form1.Left = Screen.Width - Form1.Width And Form1.Height = lngTaskBarHeight) And (Form1.Left + (x - Xs) + Form1.Width < (Screen.Width - DockScale))) Or _
               ((Form1.Top = lngTaskBarHeight - Form1.Height And Form1.Width = Screen.Width) And (Form1.Top + (y - Ys) + Form1.Height > (lngTaskBarHeight - DockScale))) Then
                blnDocked = False
                Me.Height = myHeight
                Me.Width = myWidth
            End If
            
        Else
        
             'set Left side  docking
             If Form1.Left + (x - Xs) < DockScale Then
                 Form1.Left = 0
                 Form1.Height = lngTaskBarHeight
                 Form1.Top = 0
                 blnDocked = True
                 Exit Sub
             End If
             
             'set Top side docking
             If Form1.Top + (y - Ys) < DockScale Then
                 Form1.Top = 0
                 Form1.Width = Screen.Width
                 Form1.Left = 0
                 blnDocked = True
                 Exit Sub
             End If
             
             'set right side docking
             If Form1.Left + (x - Xs) + Form1.Width > (Screen.Width - DockScale) Then
                 Form1.Left = Screen.Width - Form1.Width
                 Form1.Height = lngTaskBarHeight
                 Form1.Top = 0
                 blnDocked = True
                 Exit Sub
             End If
             
             'set bottom side docking
             If Form1.Top + (y - Ys) + Form1.Height > (lngTaskBarHeight - DockScale) Then
                 Form1.Top = lngTaskBarHeight - Form1.Height
                 Form1.Width = Screen.Width
                 Form1.Left = 0
                 blnDocked = True
                 Exit Sub
             End If
            
             'move the form finally
             Form1.Left = Form1.Left + (x - Xs)
             Form1.Top = Form1.Top + (y - Ys)
        End If
        
    End If
 
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    'set drag flag to false
    IsBeingDragged = False
End Sub