【VB】恶搞-像QQ那样圆形抖动当前活动窗口

VB 像QQ那样圆形抖动当前活动窗口，恶搞程序：

非常的好玩，注意：是抖动【当前活动】窗口，也就是那个窗口在最前边就抖动那个，做的是圆周运动。

Option Explicit

Private Type POINT
    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 Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetForegroundWindow Lib "user32" () 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

Dim r As RECT, mPOINT As POINT, bj As Long

Function GetYd(r As Long, CenterX As Long, CenterY As Long, jd As Integer)      '求圆上的某点坐标
    mPOINT.x = CenterX + r * Cos(jd * 5)
    mPOINT.y = CenterY + r * Sin(jd * 5)
End Function

Private Sub Form_Load()
    Timer1.Interval = 100
    Timer1.Enabled = True
    bj = 10                                                                     '如果想加大抖动幅度,请修改jd值
End Sub

Private Sub Timer1_Timer()
    Static i As Integer
    Dim p As Long, x As Long, y As Long
    p = GetForegroundWindow
    GetWindowRect p, r
    x = r.Left
    y = r.Top
    GetYd bj, x, y, i                                                           '让窗口像QQ那样，做圆形抖动
    MoveWindow p, mPOINT.x, mPOINT.y, r.Right - r.Left, r.Bottom - r.Top, 1     '移动窗口
    i = i + 1
    If i > 360 Then i = 1                                                       '如果大于360度，则从头开始抖动
End Sub