VB6，如何制作qq的伸缩功能

窗体加一个timer 不需要设置 以下是窗体代码 很久前写的 比较乱,拿去吧,不要笑哦

Option Explicit

Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33
Private Const SM_CYCAPTION = 4

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 SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10

Const INDENTTIME = 150
Const INDENTEDGE = 75

Dim oldX As Single
Dim oldY As Single
Dim IndentDirection As Long
Dim Outing As Boolean
Dim Indenting As Boolean
Dim IndentStep As Long
Dim IndentStepCount As Long

Private Sub Form_Load()
Timer1.Interval = 10
IndentStepCount = INDENTTIME / 10
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Indenting = False
End Sub

Private Sub Timer1_Timer()
Dim MouseIn As Boolean
Dim IndentOver As Boolean
Dim OutOver As Boolean
Dim pt As POINTAPI

If Me.WindowState <> 0 Then Exit Sub
IndentOver = False
OutOver = False
GetCursorPos pt
ScreenToClient Me.hwnd, pt
MouseIn = False
pt.x = pt.x + GetSystemMetrics(SM_CXFRAME)
pt.y = pt.y + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME)
If pt.x * 15 >= 0 And pt.x * 15 <= Me.Width And pt.y * 15 >= 0 And pt.y * 15 <= Me.Height Then
MouseIn = True
End If
If Indenting Or Outing Then
If MouseIn Then
Indenting = False
Outing = True
Else
Outing = False
Indenting = True
End If
If IndentStep >= IndentStepCount Then
IndentOver = True
ElseIf IndentStep < 0 Then
OutOver = True
End If
Select Case IndentDirection
Case 1 '左缩
If Not IndentOver And Not OutOver Then
Me.Left = -Me.Width * (IndentStep / IndentStepCount)
ElseIf IndentOver Then
Me.Left = INDENTEDGE / 2 - Me.Width
ElseIf OutOver Then
Me.Left = 0
End If
Case 2 '上缩
If Not IndentOver And Not OutOver Then
Me.Top = -Me.Height * (IndentStep / IndentStepCount)
ElseIf IndentOver Then
Me.Top = INDENTEDGE / 2 - Me.Height
ElseIf OutOver Then
Me.Top = 0
End If
Case 3 '右缩
If Not IndentOver And Not OutOver Then
Me.Left = Screen.Width - Me.Width + Me.Width * (IndentStep / IndentStepCount)
ElseIf IndentOver Then
Me.Left = Screen.Width - INDENTEDGE / 2
ElseIf OutOver Then
Me.Left = Screen.Width - Me.Width
End If
'Case 4 '下缩
' If Not IndentOver And Not OutOver Then
' Me.Top = Screen.Height - -Me.Height + Me.Height * (IndentStep / IndentStepCount)
' ElseIf IndentOver Then
' Me.Top = Screen.Height - INDENTEDGE / 2
' ElseIf OutOver Then
' Me.Top = Screen.Height - Me.Height
' End If
End Select
If OutOver Then
Outing = False
ElseIf IndentOver Then
Indenting = False
End If
If Outing Then
IndentStep = IndentStep - 1
ElseIf Indenting Then
IndentStep = IndentStep + 1
End If
oldX = Me.Left
oldY = Me.Top
Else
If oldX <> Me.Left Or oldY <> Me.Top Then
If Me.Left < 0 Then Me.Left = 0
If Me.Top < 0 Then Me.Top = 0
If Screen.Width - (Me.Left + Me.Width) < 0 Then Me.Left = Screen.Width - Me.Width
If Screen.Height - (Me.Top + Me.Height) < 0 Then Me.Top = Screen.Height - Me.Height
oldX = Me.Left
oldY = Me.Top
End If
If Me.Left < 0 Or Me.Left < 0 Or Me.Top < 0 Or Screen.Width - (Me.Left + Me.Width) < 0 Or Screen.Height - (Me.Top + Me.Height) < 0 Then
IndentOver = True
Else
OutOver = True
End If
If MouseIn Then
If Not OutOver Then
Outing = True
'BringWindowToTop Me.hwnd
'SetForegroundWindow Me.hwnd
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE
SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE
End If
Indenting = False
Else
If Not IndentOver Then Indenting = True
Outing = False
End If
If Me.Left < INDENTEDGE Then '左缩
IndentDirection = 1
IndentStep = (-Me.Left / Me.Width) * IndentStepCount
ElseIf Me.Top < INDENTEDGE Then '上缩
IndentDirection = 2
IndentStep = (-Me.Top / Me.Height) * IndentStepCount
ElseIf Screen.Width - (Me.Left + Me.Width) < INDENTEDGE Then '右缩
IndentDirection = 3
IndentStep = (Me.Left - Screen.Width + Me.Width) / Me.Width * IndentStepCount
'ElseIf Screen.Height - (Me.Top + Me.Height) < INDENTEDGE Then '下缩
' IndentDirection = 4
' IndentStep = (Me.Top - Screen.Height + Me.Height) / Me.Height * IndentStepCount
Else
Indenting = False
Outing = False
End If
End If
'If Indenting Then Debug.Print "Indenting"
'If Outing Then Debug.Print "Outing"
End Sub