Dim ctX As Long, ctY As Long, ctW As Long, ctH As Long, ctMove1 As Long
Dim ctP As Single, ctJ As Single, ctX1 As Long, ctY1 As Long, ctR As Long
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 SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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 Sub ShowStr(Optional nStr As String, Optional nSe As Long, Optional ByVal nBorder As Long)
Dim X As Long, Y As Long
Set Me.Picture = Nothing
nStr = Trim(nStr)
If nStr = "" Then nStr = "一○○度"
Me.Font.Bold = True: Me.Cls
If nBorder = 0 Then nBorder = 1
Me.Width = Me.TextWidth(nStr) + nBorder * 2 * Screen.TwipsPerPixelX
Me.Height = Me.TextHeight(nStr) + nBorder * 2 * Screen.TwipsPerPixelY
Me.ForeColor = &HFFFFFF - nSe
For X = -nBorder To nBorder
For Y = -nBorder To nBorder
Me.CurrentX = (nBorder + X) * Screen.TwipsPerPixelX
Me.CurrentY = (nBorder + Y) * Screen.TwipsPerPixelY
Me.Print nStr
Next
Next
Me.ForeColor = nSe '&HFFFFFF
Me.CurrentX = nBorder * Screen.TwipsPerPixelX
Me.CurrentY = nBorder * Screen.TwipsPerPixelY
Me.Print nStr
End Sub
Private Sub Timer1_Timer()
WinInTop Me.hWnd, True '窗口总是保持在最前
Call MoveWin
End Sub
Private Sub MoveWin()
'ctX,ctY,ctW,ctH：上次位置和大小
Dim dl As Long, nMouse As PointAPI, R As Long, Bi As Single
Dim X As Long, Y As Long
'计算图像移动后的新位置
dl = GetCursorPos(nMouse) '获取当前鼠标位置
X = ctX + ctW * 0.5 - nMouse.X: Y = ctY + ctH * 0.5 - nMouse.Y
R = Sqr(X ^ 2 + Y ^ 2) '图像中心 与 鼠标的距离
Bi = ctR / R
X = nMouse.X + X * Bi: Y = nMouse.Y + Y * Bi '连线（图像中心-鼠标）与转圈圆的交点坐标
X = X - ctX - ctW * 0.5: Y = Y - ctY - ctH * 0.5
R = Sqr(X ^ 2 + Y ^ 2) '图像中心 与 转圈圆交点 的距离
If R > 2 Then '---向鼠标靠近
Bi = ctMove1 / R '移动的距离比
If Bi > 1 Then Bi = 1 '距离小于移动距离，直接移动到转圈圆交点上
ctX = ctX + X * Bi: ctY = ctY + Y * Bi '向鼠标靠近 ctMove1 个像素
ctJ = 0
Else '-----------------------围绕鼠标鼠标转圈
If ctJ < 0.001 Then ctX1 = ctX + ctW * 0.5: ctY1 = ctY + ctH * 0.5
ctJ = ctJ + 0.04: X = ctX1: Y = ctY1
If ctJ > ctP * 2 Then ctJ = ctJ - ctP * 2
Zhuan ctJ, X, Y, nMouse.X, nMouse.Y
ctX = X - ctW * 0.5: ctY = Y - ctH * 0.5
End If
Me.Move ctX * Screen.TwipsPerPixelX, ctY * Screen.TwipsPerPixelY
End Sub
Private Sub Zhuan(ToJ As Single, X As Long, Y As Long, x0 As Long, y0 As Long)
'将点 x,y 围绕圆心 x0,y0 顺时针旋转 ToJ 角度，返回旋转后的位置
'注意：要预先设置圆周率 ctP = 3.1415926
Dim S As Single, J As Single
S = Sqr((X - x0) ^ 2 + (Y - y0) ^ 2) 'X,Y 与 x0,y0 的距离
If S = 0 Then J = 0 Else J = (Y - y0) / S '与水平线的夹角的正弦值
If Abs(J) >= 1 Then
If J > 0 Then J = ctP * 0.5 Else J = -ctP * 0.5 '90 度时的特殊情况
Else
J = Atn(J / Sqr(-J * J + 1)) '与水平线的夹角
End If
If X - x0 < 0 Then J = -ctP - J
X = x0 + S * Cos(J + ToJ): Y = y0 + S * Sin(J + ToJ) '返回旋转后的位置
End Sub
Private Sub TransWin()
'将窗口背景色设置为透明的
Dim ExsTyle As Long, Se As Long
Const WS_EX_LAYERED = &H80000, GWL_ExsTyle = -20
ExsTyle = WS_EX_LAYERED Or GetWindowLong(Me.hWnd, GWL_ExsTyle)
SetWindowLong Me.hWnd, GWL_ExsTyle, ExsTyle
Se = Me.Point(0, 0)
SetLayeredWindowAttributes Me.hWnd, Se, 0, 1
End Sub
Private Sub WinInTop(nWnd As Long, Optional InTop As Boolean)
Const HWND_NoTopMost = -2 '取消在最前
Const HWND_TopMost = -1 '最上
Const SWP_NoSize = &H1 'wFlags 参数
Const SWP_NoMove = &H2
Const SWP_NoZorder = &H4
Const SWP_ShowWindow = &H40
Const SWP_HideWindow = &H80
Dim nIn As Long
If InTop Then nIn = HWND_TopMost Else nIn = HWND_NoTopMost
SetWindowPos nWnd, nIn, 0, 0, 0, 0, SWP_NoSize + SWP_NoMove
End Sub
发表于 2014-4-16 09:02
|
发表于 2014-4-18 14:37
