vb仿qq伸缩吸附窗体完整代码的简单介绍[20240420更新]

本篇文章给大家谈谈vb仿qq伸缩吸附窗体完整代码，以及对应的知识点，希望对各位有所帮助，不要忘了收藏本站喔。

本文目录一览：

• 1、vb模仿qq窗体靠边自动隐藏
• 2、VB代码问题，类似于QQ的窗体有吸附功能，把窗体移动到屏幕边缘能悬挂起来的…
• 3、如何用vb实现象qq一样当放到窗口边上是就自己缩进去了~~求助~谁有原代码？或好的建议
• 4、利用VB实现窗体的展开与收缩

vb模仿qq窗体靠边自动隐藏

1，增加一个定时器控制，直接将代码添加到Form1靠边收缩??

显式的选项

私人函数调用GetCursorPos Lib的“USER32”（lpPoint作为POINTAPI）作为龙

私人型POINTAPI

×如龙 y为长

端类型

昏暗的P为POINTAPI

私人函数SetWindowPos Lib的“ USER32“（BYVAL HWND作为龙'长'龙，BYVAL CX，只要'wFlags，只要，只要'CY'Y为X的hWndInsertAfter作为），只要

私人常量HWND_TOPMOST = -1

私人常量SWP_NOMOVE =＆H2

私人常量SWP_NOSIZE =＆H1

私人小组Form_Load（）

调用SetWindowPos Me.hwnd，HWND_TOPMOST，0，0，0， 0，，SWP_NOMOVE或SWP_NOSIZE

Timer1.Interval = 100

Timer1.Enabled = TRUE

结束小组

私人小Timer1_Timer（）

在错误恢复下一步

调用GetCursorPos p

如果Me.Top = 0

如果PY + Me.Top Me.Height / 15/15或PX Me.Width / 15 +我左/ 15或PX Me.Left / 15

Me.Top = 0 - Me.Height + 50

如果

如果PX Me.Left / 15和PX我左/ 15 + Me.Width / 15和Py 3

Me.Top = 0

最后如果

如果Me.Left = 0

如果PY Me.Height / 15 + Me.Top / 15或PY 15还是pX Me.Width / 15 + Me.Left / 15然后

Me.Left = 0 - Me.Width + 50

如果

如果PX 3和PY Me.Top / 15和Py 我。的身高/ 15 + Me.Top的/ 15

Me.Left = 0

如果

最后如果

如果Me.Left = Screen.Width - 我宽度

如果PY Me.Height / 15 + Me.Top / 15或PY Me.Top / 15或PX Me.Left / 15

Me.Left = Screen.Width - 50

如果

如果PX Screen.Width / 15 - 3和PY Me.Top / 15和Py 我。身高/ 15 + Me.Top / 15

Me.Left = Screen.Width - Me.Width

结束如果结束如果

如果Me.Top = Screen.Height - Me.Height然后

如果PY Me.Height / 15 + Me.Top / 15或PX Me.Width / 15 + Me.Left / 15或PX我。左/ 15

Me.Top = Screen.Height + 50

如果

如果PX Me.Left / 15和PX Me.Left / 15 + Me.Width / 15和PY Screen.Height / 15 - 3

Me.Top = Screen.Height - Me.Height

最后如果

高端子...... / a

2，下面的代码是一个VB系统托盘中的代码的右下图标

第一个附加模块，模块代码

显式的选项

公共常量MAX_TOOLTIP作为整数= 64

公共常量NIF_ICON =＆H2

公共常量NIF_MESSAGE =＆H1

公共常量NIF_TIP =＆H4

公共常量NIM_ADD =＆H0

公共常量NIM_DELETE =＆H2

公共常量WM_MOUSEMOVE =＆H200

公共常量WM_LBUTTONDOWN =＆H201

公共常量WM_LBUTTONUP =＆H202

公共常量WM_LBUTTONDBLCLK =＆H203

公共常量WM_RBUTTONDOWN =＆H204

公共常量WM_RBUTTONUP =＆H205

公共常量WM_RBUTTONDBLCLK =＆H206

公共常量SW_RESTORE = 9

公共常量SW_HIDE = 0

nfIconData作为NOTIFYICONDATA

类型NOTIFYICONDATA

CBSIZE，只要

HWND，只要

UID由于长期

的uFlags由于长期

uCallbackMessage，只要

HICON，只要 BR / szTip作为字符串* MAX_TOOLTIP

端类型

公开声明函数ShowWindow LIB“USER32”（BYVAL HWND作为龙'，只要nCmdShow）龙

公开声明函数Shell_NotifyIcon LIB“SHELL32 dll“的别名吗？”Shell_NotifyIconA“（BYVAL，只要dwMessage，lpData的作为NOTIFYICONDATA）由于长期

在表单的Form_Load代码

私人子Form_Resize（）

nfIconData

。 HWND = Me.hWnd

。 UID = Me.Icon

。 uFlags = NIF_ICON或NIF_MESSAGE或NIF_TIP

。 uCallbackMessage = WM_MOUSEMOVE

。惠康= Me.Icon.Handle

。 szTip = App.Title +“（版本”App.Major＆“”＆App.Minor＆“，”＆App.Revision“）”终止vbNullChar

。 CBSIZE = LEN（nfIconData）

使用

呼叫Shell_NotifyIcon（NIM_ADD，nfIconData）

END SUB

私人小组Form_QueryUnload结束（取消为整数，UnloadMode的整数）

通话Shell_NotifyIcon（NIM_DELETE，nfIconData）

END SUB

私人：小Form_MouseMove（如Integer，Shift键为整数，X按钮单，Y As单一）

昏暗的lMsg作为单

lMsg X / Screen.TwipsPerPixelX

的选择案例lMsg

案例WM_LBUTTONUP

的ShowWindow Me.hWnd，SW_RESTORE 结束选择

高端子，

VB代码问题，类似于QQ的窗体有吸附功能，把窗体移动到屏幕边缘能悬挂起来的…

用timer判断form的位置，如果top=0就把top-form1.height'留一点点边缘出来也可以。。。

然后再用getcursorpos获取鼠标位置，如果在窗体下边缘就控制top=0

Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI

x As Long

y As Long

End Type

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

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 Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Sub Timer1_Timer()

Dim p As POINTAPI, r As RECT

GetCursorPos p

GetWindowRect Me.hwnd, r

If r.Top = 0 And (Not (p.y r.Bottom And p.x r.Left And p.x r.Right)) Then

Form1.Top = -Form1.Height + 100

End If

If p.x r.Left And p.x r.Right And p.y r.Bottom Then

If r.Top = 0 Then

SetWindowPos Me.hwnd, -2, r.Left, 0, 0, 0, 1

Else

SetWindowPos Me.hwnd, -2, r.Left, r.Top, 0, 0, 1

End If

End If

End Sub

只做了顶端吸附，侧边和低端也是差不多的

如何用vb实现象qq一样当放到窗口边上是就自己缩进去了~~求助~谁有原代码？或好的建议

大概是 当窗口坐标在屏幕顶端x个象素内 加一个循环? 然后坐标从0变为负数??

利用VB实现窗体的展开与收缩

窗体上放一TIMER控件，Interval属性为200

双击窗体写上以下代码，就和QQ的一样效果啦！

Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

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 Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Type POINTAPI

X As Long

Y As Long

End Type

Private Const HWND_TOPMOST = -1

Private Const SWP_NOSIZE = H1

Private Const SWP_NOMOVE = H2

Private Const HWND_TOP = 0

Private Const SWP_NOACTIVATE = H10

Private Const SWP_SHOWWINDOW = H40

Private Sub Form_Load()

SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE

End Sub

Private Sub Timer1_Timer()

Dim p As POINTAPI

Dim f As RECT

GetCursorPos p

GetWindowRect Me.hwnd, f

If Me.WindowState 1 Then

If p.X f.Left And p.X f.Right And p.Y f.Top And p.Y f.Bottom Then

If Me.Top 0 Then

Me.Top = -10

Me.Show

ElseIf Me.Left 0 Then

Me.Left = -10

Me.Show

ElseIf Me.Left + Me.Width = Screen.Width Then

Me.Left = Screen.Width - Me.Width + 10

Me.Show

End If

Else

If f.Top = 4 Then

Me.Top = 40 - Me.Height

ElseIf f.Left = 4 Then

Me.Left = 40 - Me.Width

ElseIf Me.Left + Me.Width = Screen.Width - 4 Then

Me.Left = Screen.Width - 40

End If

End If

End If

End Sub

vb仿qq伸缩吸附窗体完整代码的介绍就聊到这里吧，感谢你花时间阅读本站内容，更多关于、vb仿qq伸缩吸附窗体完整代码的信息别忘了在本站进行查找喔。