鼠标幽灵 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

OllyDbg丶

想做坏事，可不懂怎么用

lili2312280

什么啊。。。

adri

有没有做好的样式图片看一下呗

Suprem♂影子

看不懂太叼了

温总

adri 发表于 2014-4-16 10:50
有没有做好的样式图片看一下呗

你复制代码，运行下就知道了；