鼠标幽灵 VB源码
鼠标幽灵源码从网络上来的；大家不要做坏事。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 Form_Load()
Dim nStr As String
Me.AutoRedraw = True: Me.ScaleMode = vbTwips: Me.Caption = "鼠标幽灵"
ctP = 3.1415926 '圆周率
Me.BackColor = 123'窗口背景色，使用默认背景色会使 SetLayeredWindowAttributes 失效
ctMove1 = 6 '▲▲图像靠近鼠标时，每次移动的距离（单位：像素）
ctR = 50 '▲▲图像围绕鼠标转圈的半径（单位：像素）
Me.Font.Size = 12 '▲▲显示字符的大小
nStr = Command '显示字符或图标文件，由命令行参数指定
' nStr = "Img:C:\WINDOWS\Cursors\hcross.cur" '调试代码****，命参前面四个字符是“Img:”，表示显示指定的图片文件
' nStr = "Img:fly_girl.gif" '调试代码****，表示显示当前目录下的图片文件 fly_girl.gif
' nStr = "Img:" '调试代码****，表示显示的图像是本窗口的图标
' nStr = "我的作品" '调试代码****，命参前面四个字符不是“Img:”，表示显示字符
If UCase(Left(nStr, 4)) = "IMG:" Then
nStr = Trim(Mid(nStr, 5)) '图片文件名：类型是 VB 支持的，图片不能过大，最好小于 48×48 像素
On Error Resume Next
Me.Picture = LoadPicture(nStr)
On Error GoTo 0
If Me.Picture = 0 Then Me.Picture = Me.Icon '要绘制的图像，找不到文件或不支持此文件时用本窗口图标
Me.Move 0, 0, Picture.Width / 1.764583, Picture.Height / 1.764583 'HiMetric 单位转缇（VbTwips）
Else
ShowStr nStr, RGB(255, 0, 0), 2'用红色显示指定的字符，字符边框宽度 2 像素
End If
ctW = Me.Width / Screen.TwipsPerPixelX: ctH = Me.Height / Screen.TwipsPerPixelY
Call TransWin '将窗口背景色设置为透明的
Timer1.Enabled = True: Timer1.Interval = 20
End Sub
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
想做坏事，可不懂怎么用{:301_972:} 什么啊。。。 有没有做好的样式图片看一下呗 看不懂太叼了 adri 发表于 2014-4-16 10:50
有没有做好的样式图片看一下呗
你复制代码，运行下就知道了；{:1_918:}
页:
[1]