task.cls

模仿qq的自动隐藏功能 方便实用 短小精悍 可以

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "task"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' **********************************************************************
'  描  述：vb 实现qq的可以拖隐藏到屏幕四边的效果的控件
'  Play78.com : 网站导航，源码之家，绝对开源
'  海阔天空编写,有问题请上www.paly78.com 提
'  网址：http://www.play78.com/
'  QQ：13355575
'  e-mail:[e-mail]
'  开发时间:2005-7-3
' **********************************************************************
Private WithEvents taskform As Form
Attribute taskform.VB_VarHelpID = -1
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Public Sub SetForm(frm As Object)
Set taskform = frm
End Sub
Private Sub TaskForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim MouseOver As Boolean
    
    MouseOver = (0 <= X) And (X <= taskform.Width) And (0 <= Y) And (Y <= taskform.Height)
    If MouseOver Then
        SetCapture taskform.hWnd
        'command1.BackColor = RGB(141, 150, 206)
        taskform.label1.Caption = "鼠标移进"
    Else
        'command1.BackColor = &H80000004
        taskform.label1.Caption = "鼠标移出"
        ReleaseCapture
    End If
End Sub