VB如何实现拖动窗体吸附到桌面边缘?
跟变速齿轮的效果完全一样就行了~1、鼠标拖动时窗体跟随鼠标移动,而不是显示随动的虚线框2、靠近桌面边缘时能自动吸附就这两个问题~网上搜了很多代码都不尽人意~希望高手们教教...
跟变速齿轮的效果完全一样就行了~
1、鼠标拖动时窗体跟随鼠标移动,而不是显示随动的虚线框
2、靠近桌面边缘时能自动吸附
就这两个问题~网上搜了很多代码都不尽人意~
希望高手们教教路~VB是自学的,所以表嫌弃偶笨_| ̄|●
最好能把声明啊代码啊稍微解释一下啊~谢谢鸟~
分不够可再加点o(≥ω≤)o 展开
1、鼠标拖动时窗体跟随鼠标移动,而不是显示随动的虚线框
2、靠近桌面边缘时能自动吸附
就这两个问题~网上搜了很多代码都不尽人意~
希望高手们教教路~VB是自学的,所以表嫌弃偶笨_| ̄|●
最好能把声明啊代码啊稍微解释一下啊~谢谢鸟~
分不够可再加点o(≥ω≤)o 展开
4个回答
展开全部
'在窗体上增加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
'========代码部分=========
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
展开全部
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
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
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
部分代码
在FORM的Move事件中添加一个判断
if me.left<=你要吸附的离左边的距离 then
me.left=0
end if
if me.left>=桌面的宽-你要吸附的离右边的距离 then
me.left=桌面的宽-me.width
end if
上边和下边的也是一样
在FORM的Move事件中添加一个判断
if me.left<=你要吸附的离左边的距离 then
me.left=0
end if
if me.left>=桌面的宽-你要吸附的离右边的距离 then
me.left=桌面的宽-me.width
end if
上边和下边的也是一样
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
参考资料: http://zhidao.baidu.com/question/37604183.html?si=1
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询