VB如何实现拖动窗体吸附到桌面边缘?

2024-11-06 13:55:24
推荐回答(4个)
回答(1):

'在窗体上增加timer1控件,然后复制下面代码并运行,即可看到效果
'========代码部分=========
Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim p As POINTAPI
Dim maymove As Boolean, dx As Integer, dy As Integer

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1

Private Sub Form_Load()
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Timer1.Interval = 100
Timer1.Enabled = True
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (Button = 1) Then '如果鼠标左键按下,表示将移动窗体
Timer1.Enabled = False
dx = X 'dx为鼠标的x位置
dy = Y 'dy为鼠标的y位置
maymove = True ' maymove = True为移动控件
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Mx As Integer
Dim My As Integer
If (maymove = True) Then '如果移动控件,将窗体坐标相应移动
Mx = X - dx 'mx为鼠标x轴移动的距离
My = Y - dy 'my为鼠标y轴移动的距离
Me.Left = Me.Left + Mx
Me.Top = Me.Top + My
End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
maymove = False 'maymove = False鼠标停止移动
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
GetCursorPos p
If Me.Top <= 400 Then Me.Top = 0

If Me.Left <= 400 Then Me.Left = 0

If Me.Left + Me.Width >= Screen.Width - 400 Then Me.Left = Screen.Width - Me.Width

If Me.Top + Me.Height >= Screen.Height - 400 Then Me.Top = Screen.Height - Me.Height

End Sub

回答(2):

Dim mx As Integer
Dim my As Integer
dim StopPX as long'这个就是贴边像素数

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
mx = X
my = Y
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Me.Top = Me.Top + (Y - my)
Me.Left = Me.Left + (X - mx)
Else
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.Top < StopPX * 15 Then Me.Top = 0
If Me.Left < StopPX * 15 Then Me.Left = 0
If Me.Top < StopPX * 15 And Me.Left < 500 Then Me.Top = 0: Me.Left = 0
If Me.Top + Me.Height + StopPX * 15 * 2 > Screen.Height Then Me.Top = Screen.Height - Me.Height - 400
If Me.Left + Me.Width + StopPX * 15 > Screen.Width Then Me.Left = Screen.Width - Me.Width
End Sub

回答(3):

部分代码
在FORM的Move事件中添加一个判断
if me.left<=你要吸附的离左边的距离 then
me.left=0
end if

if me.left>=桌面的宽-你要吸附的离右边的距离 then
me.left=桌面的宽-me.width
end if

上边和下边的也是一样

回答(4):

参考这篇看看
http://zhidao.baidu.com/question/37604183.html?si=1