[Example] Form snaps to screen edge

[MerrionComputin]

Requires EventVB.dll version F or higher

The form is a standard VB form with borderstyle set to 4 - Fixed Toolwindow.

Option Explicit

Dim WithEvents vbLink As EventVB.APIFunctions
Dim WithEvents vbWnd As EventVB.ApiWindow


Dim vbWndRect As APIRect

Public Enum SnapLocation
    SnapToLeft = 0
    SnapToRight = 1
    SnapToTop = 2
    SnapToBottom = 3
End Enum
Private mSnappedTo As SnapLocation

Private FORMWIDTH As Long

'\\ Alter the tolerance if it 'snaps' to readily...
Private Const SNAPTOLERANCE = 5
Private Sub CopyRect(ByVal FromRect As APIRect, ToRect As APIRect)

With ToRect
    .Left = FromRect.Left
    .Top = FromRect.Top
    .Right = FromRect.Right
    .Bottom = FromRect.Bottom
End With

End Sub

Friend Property Let SnappedTo(ByVal newSnap As SnapLocation)

If newSnap <> mSnappedTo Then
    mnuSnap(mSnappedTo).Checked = False
    mSnappedTo = newSnap
    mnuSnap(mSnappedTo).Checked = True
    With SnapToRectangle(mSnappedTo)
        vbWnd.Move .Left, .Top, (.Right - .Left), (.Bottom - .Top), True
    End With
End If

End Property

Friend Property Get SnappedTo() As SnapLocation

SnappedTo = mSnappedTo

End Property


Private Property Get SnapToRectangle(ByVal Location As SnapLocation) As APIRect

Dim rcRet As New APIRect

With rcRet
    Select Case Location
    Case SnapToBottom
        .Bottom = Screen.Height / Screen.TwipsPerPixelY
        .Top = .Bottom - (FORMWIDTH / Screen.TwipsPerPixelY)
        .Left = 0
        .Right = Screen.Width / Screen.TwipsPerPixelX
        
    Case SnapToTop
        .Top = 0
        .Bottom = (FORMWIDTH / Screen.TwipsPerPixelY)
        .Left = 0
        .Right = Screen.Width / Screen.TwipsPerPixelX
    
    Case SnapToLeft
        .Top = 0
        .Bottom = Screen.Height / Screen.TwipsPerPixelY
        .Left = 0
        .Right = (FORMWIDTH / Screen.TwipsPerPixelX)
    
    Case SnapToRight
        .Top = 0
        .Bottom = Screen.Height / Screen.TwipsPerPixelY
        .Right = Screen.Width / Screen.TwipsPerPixelX
        .Left = .Right - (FORMWIDTH / Screen.TwipsPerPixelX)
    
    End Select
End With

Set SnapToRectangle = rcRet

End Property


Private Sub Form_Load()

Set vbLink = New EventVB.APIFunctions

FORMWIDTH = Me.Width

Set vbWnd = New EventVB.ApiWindow
vbWnd.hWnd = Me.hWnd
vbLink.SubclassedWindows.Add vbWnd

Me.SnappedTo = SnapToLeft

End Sub

Private Sub Form_Unload(Cancel As Integer)

vbLink.SubclassedWindows.Remove vbWnd

End Sub

Private Sub mnuSnap_Click(Index As Integer)

Me.SnappedTo = Index

End Sub


Private Sub vbWnd_Moving(ByVal MoveEdges As EventVB.WindowSizingEdges, MoveRectangle As EventVB.APIRect)

Dim CurRect As APIRect

Set CurRect = SnapToRectangle(Me.SnappedTo)

With MoveRectangle
    '\\ If going left, snap to left
    If .Left < (CurRect.Left - SNAPTOLERANCE) Then
        Call CopyRect(SnapToRectangle(SnapToLeft), MoveRectangle)
        Me.SnappedTo = SnapToLeft
    '\\ If going right, snap to right
    ElseIf .Right > (CurRect.Right + SNAPTOLERANCE) Then
        Call CopyRect(SnapToRectangle(SnapToRight), MoveRectangle)
        Me.SnappedTo = SnapToRight
    '\\ If going up, snap to top
    ElseIf .Top < (CurRect.Top - SNAPTOLERANCE) Then
        Call CopyRect(SnapToRectangle(SnapToTop), MoveRectangle)
        Me.SnappedTo = SnapToTop
    ElseIf .Bottom > (CurRect.Bottom + SNAPTOLERANCE) Then
        '\\ If going down, snap to bottom
        Call CopyRect(SnapToRectangle(SnapToBottom), MoveRectangle)
        Me.SnappedTo = SnapToBottom
    End If
End With

End Sub

HTH,
Duncan

[Hack]

Where does one get EventVB.Dll and how much does it cost?

[MerrionComputin]

The EventVB.dll is freeware, downloadable from this page with the additional info in the overview page

HTH,
Duncan

[Hack]

Thanks!!!