[Example] Form snaps to screen edge

Requires EventVB.dll version F or higher

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

Code:

---

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

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

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

HTH,
Duncan

Thanks!!! :)