求 像 OICQ 那样的窗体效果。谢谢~~~

Question

'分是少了点，不过为了兄弟辛苦一下了'获得鼠标指针在屏幕坐标上的位置
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 LongConst 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 Command1_Click(Index As Integer)
  Form1.SetFocus
  Select Case Index
     Case 0
         Form1.PopupMenu Form2.mnu_file, vbPopupMenuLeftAlign, 240, max - 30
     Case 1
     Case 7
         Command1(8).Enabled = Not Command1(8).Enabled
         If Command1(8).Enabled = True Then
             Command1(7).Picture = Image2(1).Picture
             Picture1.Width = 4455
             Form1.Width = Form1.Width + 1820
         Else
             Command1(7).Picture = Image2(0).Picture
             Picture1.Width = 2645
             Form1.Width = Form1.Width - 1820
         End If
         Line (0, 0)-(Form1.Width, Form1.Height), vbBlue, BF
         Get_Windows_Rect
     '......
     Case 13
         End
     '  .....
  End Select
End SubPrivate Sub Form_Load()
        Timer1.Interval = 50: Timer2.Interval = 1000
        Form1.BackColor = vbBlue
        Get_Windows_Rect
End Sub
Sub Get_Windows_Rect()
        Dim dl&
        max = 390: 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 SubPrivate Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Is_Move_B Then
     Movex = MyPoint.X - MyRect.Left
     Movey = MyPoint.Y - MyRect.Top
     Is_Movestar_B = True
End If
End SubPrivate Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
       Dim dl&
       If Is_Movestar_B Then
            dl& = MoveWindow(Form1.hwnd, MyPoint.X - Movex, MyPoint.Y - Movey, _
                          MyRect.Right - MyRect.Left, MyRect.Bottom, -1)
       End If
End SubPrivate Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Get_Windows_Rect
    Is_Movestar_B = False
End SubPrivate Sub Timer1_Timer()
       Dim dl&
       dl& = GetCursorPos(MyPoint)
            If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
                     Form1.Height = max) Or MyPoint.Y <= 3 Then
           '  If MyPoint.Y <= 3 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 SubPrivate Sub Timer2_Timer()
    Static color As Integer
    If color > 64 Then color = 0
    Line (0, 0)-(Form1.Width, Form1.Height), QBColor(color Mod 16), BF
    color = color + 15
End Sub

Answer 1

shawls(小山)(无业游民)(VB版的众矢之的) :
---------------------------------------------------
我说的不是那个效果，是窗体相吸的效果。谢谢~~~

Answer 2

自己去处理WM_MOVING消息
可以参考：http://www.21code.com/codebase/?pos=down&id=1982源码类型： VisualBasic源码-窗口界面   
上传时间： 2002-03-12  
下载次数： 688  
源码大小： 6 KB 源码评价：       
预计下载时间： 33.6K:0时0分1秒 56K:0时0分0秒 128K:0时0分0秒  源码简介：制作象WinAmp那样的“磁性窗体”的完整示例