VERSION 5.00
Begin VB.UserControl TaskBar 
   BackColor       =   &H00808000&
   ClientHeight    =   2970
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5460
   InvisibleAtRuntime=   -1  'True
   ScaleHeight     =   2970
   ScaleWidth      =   5460
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   4680
      Top             =   1560
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   0
      Picture         =   "TaskForm.ctx":0000
      Top             =   0
      Width           =   480
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Task Bar"
      Height          =   390
      Left            =   0
      TabIndex        =   0
      Top             =   720
      Width           =   660
   End
End
Attribute VB_Name = "TaskBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

' **********************************************************************
'  描  述：vb 實現qq的可以拖隱藏到屏幕四邊的效果的控件
'  Play78.com : 網站導航，源碼之家，絕對開源
'  海闊天空編寫,有問題請上www.paly78.com 提
'  網址：http://www.play78.com/
'  QQ：13355575
'  e-mail:hglai@eyou.com
'  開發時間:2005-7-3
' **********************************************************************
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long '用于獲取鼠標位置
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) 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

Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1

Private Enum MoveActionEnum
  ToTop
  ToLeft
  ToBottom
  ToRight
End Enum

Private Type POINTAPI '存儲鼠標位置的類型
        X As Long
        Y As Long
End Type
Dim frm As Object, MoveAction As MoveActionEnum

'缺省屬性值:
Const m_def_MoveLength = 500
Const m_def_GoLeft = 1
Const m_def_GoTop = 1
Const m_def_GoRight = 1
Const m_def_GoBottom = 1
Const m_def_OnTop = 0
'屬性變量:
Dim m_MoveLength As Long
Dim m_GoLeft As Boolean
Dim m_GoTop As Boolean
Dim m_GoRight As Boolean
Dim m_GoBottom As Boolean
Dim m_OnTop As Boolean



'注意！不要刪除或修改下列被注釋的行！
'MemberInfo=8,0,0,500
Public Property Get MoveLength() As Long
  MoveLength = m_MoveLength
End Property

Public Property Let MoveLength(ByVal New_MoveLength As Long)
  m_MoveLength = New_MoveLength
  PropertyChanged "MoveLength"
End Property

'注意！不要刪除或修改下列被注釋的行！
'MemberInfo=0,0,0,1
Public Property Get GoLeft() As Boolean
  GoLeft = m_GoLeft
End Property

Public Property Let GoLeft(ByVal New_GoLeft As Boolean)
  m_GoLeft = New_GoLeft
  PropertyChanged "GoLeft"
End Property

'注意！不要刪除或修改下列被注釋的行！
'MemberInfo=0,0,0,1
Public Property Get GoTop() As Boolean
  GoTop = m_GoTop
End Property

Public Property Let GoTop(ByVal New_GoTop As Boolean)
  m_GoTop = New_GoTop
  PropertyChanged "GoTop"
End Property

'注意！不要刪除或修改下列被注釋的行！
'MemberInfo=0,0,0,1
Public Property Get GoRight() As Boolean
  GoRight = m_GoRight
End Property

Public Property Let GoRight(ByVal New_GoRight As Boolean)
  m_GoRight = New_GoRight
  PropertyChanged "GoRight"
End Property

'注意！不要刪除或修改下列被注釋的行！
'MemberInfo=0,0,0,1
Public Property Get GoBottom() As Boolean
  GoBottom = m_GoBottom
End Property

Public Property Let GoBottom(ByVal New_GoBottom As Boolean)
  m_GoBottom = New_GoBottom
  PropertyChanged "GoBottom"
End Property


'注意！不要刪除或修改下列被注釋的行！
'MemberInfo=0,0,0,0
Public Property Get OnTop() As Boolean
  OnTop = m_OnTop
End Property

Public Property Let OnTop(ByVal New_OnTop As Boolean)
  m_OnTop = New_OnTop
  If m_OnTop = True Then SetWindowPos frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Else SetWindowPos frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
  PropertyChanged "OnTop"
End Property


'為用戶控件初始化屬性
Private Sub UserControl_InitProperties()
  m_MoveLength = m_def_MoveLength
  m_GoLeft = m_def_GoLeft
  m_GoTop = m_def_GoTop
  m_GoRight = m_def_GoRight
  m_GoBottom = m_def_GoBottom
  m_OnTop = m_def_OnTop
End Sub

'從存貯器中加載屬性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
If frm Is Nothing Then Set frm = UserControl.Parent
If Ambient.UserMode = True Then Timer1.Enabled = True Else Timer1.Enabled = False
  m_MoveLength = PropBag.ReadProperty("MoveLength", m_def_MoveLength)
  m_GoLeft = PropBag.ReadProperty("GoLeft", m_def_GoLeft)
  m_GoTop = PropBag.ReadProperty("GoTop", m_def_GoTop)
  m_GoRight = PropBag.ReadProperty("GoRight", m_def_GoRight)
  m_GoBottom = PropBag.ReadProperty("GoBottom", m_def_GoBottom)
  m_OnTop = PropBag.ReadProperty("OnTop", m_def_OnTop)
  If m_OnTop = True Then SetWindowPos frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Else SetWindowPos frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE

End Sub

Private Sub UserControl_Resize()
UserControl.Height = 500: UserControl.Width = 500
End Sub

'將屬性值寫到存儲器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

  Call PropBag.WriteProperty("MoveLength", m_MoveLength, m_def_MoveLength)
  Call PropBag.WriteProperty("GoLeft", m_GoLeft, m_def_GoLeft)
  Call PropBag.WriteProperty("GoTop", m_GoTop, m_def_GoTop)
  Call PropBag.WriteProperty("GoRight", m_GoRight, m_def_GoRight)
  Call PropBag.WriteProperty("GoBottom", m_GoBottom, m_def_GoBottom)
  Call PropBag.WriteProperty("OnTop", m_OnTop, m_def_OnTop)
End Sub


Private Sub Timer1_Timer()
    Dim pCursor As POINTAPI
    GetCursorPos pCursor '獲取當前鼠標位置
    If frm.Left < 15 * pCursor.X And 15 * pCursor.X < frm.Left + frm.Width And frm.Top - 50 < 15 * pCursor.Y _
        And 15 * pCursor.Y < frm.Top + frm.Height + 50 Then '復雜的判斷過程，判斷鼠標是否位于窗體區域內
        If frm.Left <= 0 Then MoveAction = ToLeft: If m_GoLeft = True Then Call DownForm
        If frm.Top <= 0 Then MoveAction = ToTop: If m_GoTop = True Then Call DownForm
        If frm.Left + frm.Width > Screen.Width + 10 Then MoveAction = ToRight: If m_GoRight = True Then Call DownForm
    Else
      If frm.Left <= 100 Then MoveAction = ToLeft:  If m_GoLeft = True Then Call UpForm
      If frm.Top <= 200 Then MoveAction = ToTop:  If m_GoTop = True Then Call UpForm
      If frm.Left + frm.Width >= Screen.Width - 10 Then MoveAction = ToRight:  If m_GoRight = True Then Call UpForm
    End If
End Sub

Private Sub UpForm() '窗體上移
On Error Resume Next
If (GetKeyState(vbKeyLButton) And &H8000) Then Exit Sub '鼠標按下
Select Case MoveAction
Case ToTop
    If frm.Top <= m_MoveLength + 50 - frm.Height Then
      frm.Top = 50 - frm.Height
      Exit Sub
    ElseIf frm.Top < 50 - frm.Height Then
      Exit Sub
    End If
    frm.Top = frm.Top - m_MoveLength
Case ToLeft
    If frm.Left <= m_MoveLength + 50 - frm.Width Then
      frm.Left = 50 - frm.Width
      Exit Sub
    ElseIf frm.Left < 50 - frm.Width Then
      Exit Sub
    End If
    frm.Left = frm.Left - m_MoveLength
Case ToRight
    If frm.Left > Screen.Width - m_MoveLength Then
      frm.Left = Screen.Width - 30
      Exit Sub
    End If
    frm.Left = frm.Left + m_MoveLength
    
End Select
End Sub

Private Sub DownForm() '窗體下移
On Error Resume Next
Select Case MoveAction
Case ToTop
    If frm.Top >= -m_MoveLength - 50 Then
      frm.Top = 10
      Exit Sub
    End If
    frm.Top = frm.Top + m_MoveLength
Case ToLeft
    If frm.Left >= -m_MoveLength - 150 Then
      frm.Left = -150
      Exit Sub
    End If
    frm.Left = frm.Left + m_MoveLength
Case ToRight
    If frm.Left <= Screen.Width - frm.Width + m_MoveLength + 150 Then
      frm.Left = Screen.Width - frm.Width + 150
      Exit Sub
    End If
    frm.Left = frm.Left - m_MoveLength
End Select
End Sub