|
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 |