How to make the effect of form pull-down retraction

thor5108

It is similar to shrinking the window on QQ. . . . . . To look like it was stowed

airelemental

Can use specialized controls.

kidsex

Bangding, where are there such controls, I also want

asukajjj

Decrement the height of the form with a timer control

四不像君

Add that the contraction is diminishing and it needs acceleration.

thor5108

It's ugly to only control the height of the form

cjly01

Provide a set of codes and see if it can meet your needs.
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 = 10745
        Form1.Width = 10770
        
      End Sub
Sub Get_Windows_Rect()
        Dim dl&
        max = 2200: Form1.Height = max'form height adjustment
        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