下拉式悬浮窗代码介绍
八、悬浮窗体的功能与代码
奥运邮集有夏季29届、冬季20届,因为需要向用户提供一个友好的、操作方便的换届方式。为此,偶在奥运邮集软件中采用了几种不同的窗体切换方式:
1、主页上的菜单——即通过主页上的菜单(见图a1-tp3)。打开任一届奥运邮集。该方式的特点是,通过该菜单可以连续打开各届奥运邮集;
2、各届奥运邮集的换页钮和换届钮——该方式的特点是:
(1)可以连续打开本届各页邮票或相邻届的奥运邮集的第一页;
(2)点击窗体右上角的关闭钮,可单独关闭该窗体;
(3)点击退出本届奥运邮集时,可同时关闭本届所有已打开的窗体;(注:这组代码上面39楼已介绍过了)
3、采用隐藏在屏幕左边的悬浮窗体切换各届奥运邮集——这一方式的特点是打开一届,即关闭已打开的其余各届(注:此代码上面31楼已介绍过了);
下面,向大家介绍一组下拉式悬浮窗的代码:(悬浮窗隐藏在屏幕上方:)
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 PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) 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 Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const HWND_TOPMOST = -1
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Is_Move_B As Boolean
Private Is_Movestar_B As Boolean
Private MyRect As RECT
Private MyPoint As POINTAPI
Private Movex As Long, Movey As Long
Private max As Long
Private Sub Form_Load()
Timer1.Interval = 50: Timer2.Interval = 1000
Form1.BackColor = vbBlue
Get_Windows_Rect
Picture1.Width = 10700
Form1.Width = 10770
End Sub
Sub Get_Windows_Rect()
Dim dl&
max = 2200: Form1.Height = max '窗体高度调整
Form1.Top = 0
dl& = GetWindowRect(Form1.hwnd, MyRect)
End Sub
Private Sub Form_Paint()
If PtInRect(MyRect, MyPoint.X, MyPoint.Y) = 0 Then
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, _
Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Form1.Height \ Screen.TwipsPerPixelY, 0
End If
End Sub
Private Sub Timer1_Timer()
Dim dl&
dl& = GetCursorPos(MyPoint)
If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
Form1.Height = max) Or MyPoint.Y <= 30 Then
Form1.BackColor = vbBlue
Form1.Height = max
If MyPoint.X - MyRect.Left <= 10 Or Is_Movestar_B Then
Screen.MousePointer = 15
Is_Move_B = True
Else
Screen.MousePointer = 0
Is_Move_B = False
End If
Else
If Not Is_Movestar_B Then
Form1.Height = 30
End If
End If
End Sub