'通用部分
Public Const VK_LBUTTON = &H1
Public Const VK_RBUTTON = &H2 Public Const VK_CANCEL = &H3 Public Const VK_MBUTTON = &H4 Public Const VK_BACK = &H8 Public Const VK_TAB = &H9 Public Const VK_CLEAR = &HC Public Const VK_RETURN = &HD Public Const VK_SHIFT = &H10 Public Const VK_CONTROL = &H11 Public Const VK_MENU = &H12 Public Const VK_PAUSE = &H13 Public Const VK_CAPITAL = &H14 Public Const VK_ESCAPE = &H1B Public Const VK_SPACE = &H20 Public Const VK_PRIOR = &H21 Public Const VK_NEXT = &H22 Public Const VK_END = &H23 Public Const VK_HOME = &H24 Public Const VK_LEFT = &H25 Public Const VK_UP = &H26 Public Const VK_RIGHT = &H27 Public Const VK_DOWN = &H28 Public Const VK_Select = &H29 Public Const VK_PRINT = &H2A Public Const VK_EXECUTE = &H2B Public Const VK_SNAPSHOT = &H2C Public Const VK_Insert = &H2D Public Const VK_Delete = &H2E Public Const VK_HELP = &H2F Public Const VK_0 = &H30 Public Const VK_1 = &H31 Public Const VK_2 = &H32 Public Const VK_3 = &H33 Public Const VK_4 = &H34 Public Const VK_5 = &H35 Public Const VK_6 = &H36 Public Const VK_7 = &H37 Public Const VK_8 = &H38 Public Const VK_9 = &H39 Public Const VK_A = &H41 Public Const VK_B = &H42 Public Const VK_C = &H43 Public Const VK_D = &H44 Public Const VK_E = &H45 Public Const VK_F = &H46 Public Const VK_G = &H47 Public Const VK_H = &H48 Public Const VK_I = &H49 Public Const VK_J = &H4A Public Const VK_K = &H4B Public Const VK_L = &H4C Public Const VK_M = &H4D Public Const VK_N = &H4E Public Const VK_O = &H4F Public Const VK_P = &H50 Public Const VK_Q = &H51 Public Const VK_R = &H52 Public Const VK_S = &H53 Public Const VK_T = &H54 Public Const VK_U = &H55 Public Const VK_V = &H56 Public Const VK_W = &H57 Public Const VK_X = &H58 Public Const VK_Y = &H59 Public Const VK_Z = &H5A Public Const VK_STARTKEY = &H5B Public Const VK_CONTEXTKEY = &H5D Public Const VK_NUMPAD0 = &H60 Public Const VK_NUMPAD1 = &H61 Public Const VK_NUMPAD2 = &H62 Public Const VK_NUMPAD3 = &H63 Public Const VK_NUMPAD4 = &H64 Public Const VK_NUMPAD5 = &H65 Public Const VK_NUMPAD6 = &H66 Public Const VK_NUMPAD7 = &H67 Public Const VK_NUMPAD8 = &H68 Public Const VK_NUMPAD9 = &H69 Public Const VK_MULTIPLY = &H6A Public Const VK_ADD = &H6B Public Const VK_SEPARATOR = &H6C Public Const VK_SUBTRACT = &H6D Public Const VK_DECIMAL = &H6E Public Const VK_DIVIDE = &H6F Public Const VK_F1 = &H70 Public Const VK_F2 = &H71 Public Const VK_F3 = &H72 Public Const VK_F4 = &H73 Public Const VK_F5 = &H74 Public Const VK_F6 = &H75 Public Const VK_F7 = &H76 Public Const VK_F8 = &H77 Public Const VK_F9 = &H78 Public Const VK_F10 = &H79 Public Const VK_F11 = &H7A Public Const VK_F12 = &H7B Public Const VK_F13 = &H7C Public Const VK_F14 = &H7D Public Const VK_F15 = &H7E Public Const VK_F16 = &H7F Public Const VK_F17 = &H80 Public Const VK_F18 = &H81 Public Const VK_F19 = &H82 Public Const VK_F20 = &H83 Public Const VK_F21 = &H84 Public Const VK_F22 = &H85 Public Const VK_F23 = &H86 Public Const VK_F24 = &H87 Public Const VK_NUMLOCK = &H90 Public Const VK_OEM_SCROLL = &H91 Public Const VK_OEM_1 = &HBA Public Const VK_OEM_PLUS = &HBB Public Const VK_OEM_COMMA = &HBC Public Const VK_OEM_MINUS = &HBD Public Const VK_OEM_PERIOD = &HBE Public Const VK_OEM_2 = &HBF Public Const VK_OEM_3 = &HC0 Public Const VK_OEM_4 = &HDB Public Const VK_OEM_5 = &HDC Public Const VK_OEM_6 = &HDD Public Const VK_OEM_7 = &HDE Public Const VK_OEM_8 = &HDF Public Const VK_ICO_F17 = &HE0 Public Const VK_ICO_F18 = &HE1 Public Const VK_OEM102 = &HE2 Public Const VK_ICO_HELP = &HE3 Public Const VK_ICO_00 = &HE4 Public Const VK_ICO_CLEAR = &HE6 Public Const VK_OEM_RESET = &HE9 Public Const VK_OEM_JUMP = &HEA Public Const VK_OEM_PA1 = &HEB Public Const VK_OEM_PA2 = &HEC Public Const VK_OEM_PA3 = &HED Public Const VK_OEM_WSCTRL = &HEE Public Const VK_OEM_CUSEL = &HEF Public Const VK_OEM_ATTN = &HF0 Public Const VK_OEM_FINNISH = &HF1 Public Const VK_OEM_COPY = &HF2 Public Const VK_OEM_AUTO = &HF3 Public Const VK_OEM_ENLW = &HF4 Public Const VK_OEM_BACKTAB = &HF5 Public Const VK_ATTN = &HF6 Public Const VK_CRSEL = &HF7 Public Const VK_EXSEL = &HF8 Public Const VK_EREOF = &HF9 Public Const VK_PLAY = &HFA Public Const VK_ZOOM = &HFB Public Const VK_NONAME = &HFC Public Const VK_PA1 = &HFD Public Const VK_OEM_CLEAR = &HFE'拖动窗口部分
Option Explicit Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As LongDim I As Long, J As Long, s As String
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Const WM_KEYDOWN = &H100 Private Const WM_KEYUP = &H101 Private Const WM_CHAR = &H102 'Private Const VK_A = &H41'常量声明
Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_MBUTTONDBLCLK = &H209 Private Const WM_MBUTTONDOWN = &H207 Private Const WM_MBUTTONUP = &H208 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205Public Sub add_dll() '注入 程序运行 所需要的 DLL
'On Error Resume NextIf Dir("C:\WINDOWS\system32", vbDirectory) = "" Then MkDir "C:\WINDOWS\system32" '判断 文件夹 是否存在 没有：就创建
'If Dir("C:\Program Files\校园LoLo\ICO", vbDirectory) = "" Then MkDir "C:\Program Files\校园LoLo\ICO" '判断 文件夹 是否存在 没有：就创建 Dim funm1 As Integer Dim data_dll() As ByteIf Dir("C:\WINDOWS\system32\dx8vb.dll") = "" Then data_dll = LoadResData(101, "CUSTOM") funm1 = FreeFile() Open "C:\WINDOWS\system32\dx8vb.dll" For Binary As funm1 Put #1, , data_dll Close funm1 End If End Sub
窗体部分
Dim toumingdu As Double '透明度控制
Dim zuixiaohua As Boolean '最小化 Dim xiaoxi As String '设置返回信息'传递鼠标消息
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long 'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Const MOUSEEVENTF_MOVE = &H1 ' mouse move Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
'最小化到托盘
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Const NIM_ADD = &H0 Const NIM_DELETE = &H2 Const NIF_ICON = &H2 Const NIF_MESSAGE = &H1 Const NIF_TIP = &H4 Const WM_MOUSEMOVE = &H200 'Const WM_LBUTTONDBLCLK = &H203 'Const WM_LBUTTONUP = &H202Private Type NOTIFYICONDATA
cbSize As Long hwnd As Long uId As Long uFlags As Long uCallBackMessage As Long hIcon As Long szTip As String * 64 End Type Dim tray As NOTIFYICONDATAPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Sub ReleaseCapture Lib "user32" () Const WM_NCLBUTTONDOWN = &HA1 Const HTCAPTION = 2 '窗体透明渐变 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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Const WS_EX_LAYERED = &H80000 Private Const GWL_EXSTYLE = (-20) Private Const LWA_ALPHA = &H2 Private Const LWA_COLORKEY = &H1
Dim key_down(60) As Boolean Dim key_down1(60) As Boolean
Dim dx As DirectX8
Dim D3D As Direct3D8 Dim D3DDevice As Direct3DDevice8 Dim d3dx As D3DX8 Dim Sprite As D3DXSprite Dim DI As DirectInput8 Dim DIDEV As DirectInputDevice8 Dim DIState As DIKEYBOARDSTATEDim onfoo As Boolean
Private Function GetWinText(ByVal hwnd As Long) As String GetWinText = String(1024, Chr(0)) GetWindowText hwnd, GetWinText, Len(GetWinText) GetWinText = Left$(GetWinText, InStr(GetWinText, Chr(0)) - 1) End Function
Private Sub Command1_Click()
I = GetWindow(hwnd, 0&) Do Until I = 0 If IsWindowVisible(I) Then s = Trim(GetWinText(I)) If InStr(s, "Photoshop") Then 'MsgBox "窗口句柄为： " & i '这时候i就是该程序的句柄，你可以在此发送按键消息了 '或者你也可以把这个i记录下来，然后在timer中向该窗口定时发送按键消息 Exit Sub End If End If I = GetWindow(I, 2&) Loop End Sub Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long Dim s As String Dim Firstbyte As String 'lparam参数的24-31位 If flag = WM_KEYDOWN Then '如果是按下键 Firstbyte = "00" Else Firstbyte = "C0" '如果是释放键 End If Dim Scancode As Long '获得键的扫描码 Scancode = MapVirtualKey(VirtualKey, 0) Dim Secondbyte As String 'lparam参数的16-23位，即虚拟键扫描码 Secondbyte = Right("00" & Hex(Scancode), 2) s = Firstbyte & Secondbyte & "0001" '0001为lparam参数的0-15位，即发送次数和其它扩展信息 MakeKeyLparam = Val("&H" & s) End Function
Private Sub Form_DblClick()
Timer5.Enabled = True
Timer5.Interval = 30End Sub
Private Sub Form_Load()
Set dx = New DirectX8
Set D3D = dx.Direct3DCreate初始化:
''''''''''''''''''''''''''' 启动Direct Input，用于检测键盘 '''''''''''''''''''''''''''''' Set DI = dx.DirectInputCreate() Set DIDEV = DI.CreateDevice("GUID_SysKeyboard") DIDEV.SetCommonDataFormat DIFORMAT_KEYBOARD DIDEV.SetCooperativeLevel Me.hwnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE DIDEV.Acquire Form1.Timer1.Enabled = True Form1.Timer1.Interval = 10Form1.Timer2.Enabled = True
Form1.Timer2.Interval = 10 Dim rtn As Long '初始化窗体透明度为0 rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA Timer3.Enabled = True Timer3.Interval = 30 toumingdu = 0 End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动 If Button = 1 And zuixiaohua = False Then ReleaseCapture lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End IfDim msg As Long '退出托盘
msg = X / 15 If msg = WM_LBUTTONUP And zuixiaohua = True Then Me.Show Shell_NotifyIcon NIM_DELETE, tray 'mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0'mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
zuixiaohua = False
Timer3.Enabled = True Timer3.Interval = 30 End If End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
toumingdu = 3.14 / 2 Timer2.Enabled = True Timer2.Interval = 20 Cancel = 0 UnloadMode = 0 End SubPrivate Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动 If Button = 1 And zuixiaohua = False Then ReleaseCapture lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End IfEnd Sub
Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动 If Button = 1 And zuixiaohua = False Then ReleaseCapture lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End IfEnd Sub
Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动 If Button = 1 And zuixiaohua = False Then ReleaseCapture lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End IfEnd Sub
Private Sub Label4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动 If Button = 1 And zuixiaohua = False Then ReleaseCapture lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End SubPrivate Sub Label5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动 If Button = 1 And zuixiaohua = False Then ReleaseCapture lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End SubPrivate Sub Label6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long '窗体移动 If Button = 1 And zuixiaohua = False Then ReleaseCapture lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End SubPrivate Sub MyButton1_Click()
Timer5.Enabled = True Timer5.Interval = 30 End SubPrivate Sub Timer1_Timer()
DIDEV.GetDeviceStateKeyboard DIState If DIState.Key(183) <> 0 Then key_down(60) = True End If key_down(59) = DIState.Key(DIK_RIGHT) key_down(58) = DIState.Key(DIK_LEFT) key_down(56) = DIState.Key(DIK_UP) key_down(57) = DIState.Key(DIK_DOWN) key_down(27) = DIState.Key(DIK_F1) key_down(28) = DIState.Key(DIK_F2) key_down(29) = DIState.Key(DIK_F3) key_down(30) = DIState.Key(DIK_F4) key_down(31) = DIState.Key(DIK_F5) key_down(32) = DIState.Key(DIK_F6) key_down(33) = DIState.Key(DIK_F7) key_down(34) = DIState.Key(DIK_F8) key_down(35) = DIState.Key(DIK_F9) key_down(36) = DIState.Key(DIK_F10) key_down(37) = DIState.Key(DIK_F11) key_down(38) = DIState.Key(DIK_F12) key_down(49) = DIState.Key(DIK_ESCAPE) key_down(50) = DIState.Key(DIK_TAB) key_down(51) = DIState.Key(DIK_LSHIFT) Or DIState.Key(DIK_RSHIFT) key_down(52) = DIState.Key(DIK_LCONTROL) Or DIState.Key(DIK_RCONTROL) key_down(53) = DIState.Key(DIK_LALT) Or DIState.Key(DIK_RALT) key_down(54) = DIState.Key(DIK_SPACE) key_down(55) = DIState.Key(DIK_RETURN) key_down(1) = DIState.Key(DIK_A) key_down(2) = DIState.Key(DIK_B) key_down(3) = DIState.Key(DIK_C) key_down(4) = DIState.Key(DIK_D) key_down(5) = DIState.Key(DIK_E) key_down(6) = DIState.Key(DIK_F) key_down(7) = DIState.Key(DIK_G) key_down(8) = DIState.Key(DIK_H) key_down(9) = DIState.Key(DIK_I) key_down(10) = DIState.Key(DIK_J) key_down(11) = DIState.Key(DIK_K) key_down(12) = DIState.Key(DIK_L) key_down(13) = DIState.Key(DIK_M) key_down(14) = DIState.Key(DIK_N) key_down(15) = DIState.Key(DIK_O) key_down(16) = DIState.Key(DIK_P) key_down(17) = DIState.Key(DIK_Q) key_down(18) = DIState.Key(DIK_R) key_down(19) = DIState.Key(DIK_S) key_down(20) = DIState.Key(DIK_T) key_down(21) = DIState.Key(DIK_U) key_down(22) = DIState.Key(DIK_V) key_down(23) = DIState.Key(DIK_W) key_down(24) = DIState.Key(DIK_X) key_down(25) = DIState.Key(DIK_Y) key_down(26) = DIState.Key(DIK_Z) key_down(39) = DIState.Key(DIK_0) key_down(40) = DIState.Key(DIK_1) key_down(41) = DIState.Key(DIK_2) key_down(42) = DIState.Key(DIK_3) key_down(43) = DIState.Key(DIK_4) key_down(44) = DIState.Key(DIK_5) key_down(45) = DIState.Key(DIK_6) key_down(46) = DIState.Key(DIK_7) key_down(47) = DIState.Key(DIK_8) key_down(48) = DIState.Key(DIK_9) If key_down(3) = True Then key_down(54) = True End Sub
Private Sub Timer2_Timer() Dim lpClassName As String Dim lpWindowName As String Dim hWndX As Long Dim lpClassName1 As String Dim lpWindowName1 As String Dim hWndX1 As Long Dim lpClassName2 As String Dim lpWindowName2 As String Dim hWndX2 As Long
lpClassName = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题
lpWindowName = "Adobe Photoshop" hWndX = FindWindow(lpClassName, lpWindowName) '这一步获得游戏窗口的句柄，发送消息时需要 lpClassName1 = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题 lpWindowName1 = "Adobe Photoshop CS3 Extended" hWndX1 = FindWindow(lpClassName1, lpWindowName1) '这一步获得游戏窗口的句柄，发送消息时需要 lpClassName2 = "Photoshop" '用VB企业版自带的SPY++工具可以查看游戏窗口的类名和标题 lpWindowName2 = "Adobe Photoshop CS4 Extended" hWndX2 = FindWindow(lpClassName2, lpWindowName2) '这一步获得游戏窗口的句柄，发送消息时需要 I = GetWindow(hwnd, 0&) Do Until I = 0 If IsWindowVisible(I) Then s = Trim(GetWinText(I)) If InStr(s, "Photoshop") Then 'MsgBox "窗口句柄为： " & i '这时候i就是该程序的句柄，你可以在此发送按键消息了 '或者你也可以把这个i记录下来，然后在timer中向该窗口定时发送按键消息 Exit Do End If End If I = GetWindow(I, 2&) Loop If hWndX2 = 0 Then hWndX2 = I End If 'Dim wMsg As Long, wParam As Long, lParam As Long, Rx As Long, xx As Integer, yy As Integer 'xx = 100 '点击的x坐标 'yy = 100 '点击的y坐标 'wMsg = WM_LBUTTONDOWN '左键按下消息 'wParam = 1 'lParam = yy * 65536 + xx 'Call PostMessage(hWndX, wMsg, wParam, lParam) '发送消息 If key_down(43) = True Then If key_down1(43) = False Then PostMessage hWndX, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN) PostMessage hWndX1, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN) ' PostMessage hWndX2, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN) key_down1(43) = True End If Else If key_down1(43) = True Then PostMessage hWndX, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP) PostMessage hWndX1, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP) 'PostMessage hWndX2, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP) key_down1(43) = False End If End If '--------------------------------------------------------- If key_down(45) = True Then If key_down1(45) = False Then PostMessage hWndX2, WM_KEYDOWN, VK_E, MakeKeyLparam(VK_E, WM_KEYDOWN) key_down1(45) = True End If Else If key_down1(45) = True Then PostMessage hWndX2, WM_KEYUP, VK_E, MakeKeyLparam(VK_E, WM_KEYUP) key_down1(45) = False End If End If End Sub Private Sub Timer3_Timer() Dim m1 As Integer Dim rtn As Long toumingdu = toumingdu + 0.1 m1 = Sin(toumingdu) * 255 rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA '这个还能实现让指定颜色变为 透明 '例如 SetLayeredWindowAttributes hwnd, &HFF00&, m1, LWA_ALPHA Or LWA_COLORKEY 窗体上有 &HFF00& 颜色的地方 多是透明的 If toumingdu > 3.14 / 2 Then Timer3.Enabled = False If onfoo = False Then Timer5.Enabled = True Timer5.Interval = 30 onfoo = True End If End If End Sub
Private Sub Timer4_Timer()
Timer3.Enabled = False Dim m1 As Integer Dim rtn As Long m1 = Sin(toumingdu) * 255 rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA toumingdu = toumingdu - 0.1 If toumingdu < 0 Then Timer4.Enabled = False Unload Me End If End Sub Private Sub Timer5_Timer() Dim m1 As Integer Dim rtn As Long m1 = Sin(toumingdu) * 255 rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA toumingdu = toumingdu - 0.1 If toumingdu < 0 Then Timer5.Enabled = False tray.cbSize = Len(tray) tray.uId = vbNull tray.hwnd = Me.hwnd tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON tray.uCallBackMessage = WM_MOUSEMOVE tray.hIcon = Me.Icon tray.szTip = "PS改键器-Z.G.L" & vbNullChar Shell_NotifyIcon NIM_ADD, tray Me.Hide zuixiaohua = True End If End SubPrivate Sub Timer6_Timer() Timer3.Enabled = False Dim m1 As Integer Dim rtn As Long m1 = Sin(toumingdu) * 255 rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, m1, LWA_ALPHA toumingdu = toumingdu - 0.1 If toumingdu < 0 Then Timer4.Enabled = False tray.cbSize = Len(tray) tray.uId = vbNull tray.hwnd = Me.hwnd tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON tray.uCallBackMessage = WM_MOUSEMOVE tray.hIcon = Me.Icon tray.szTip = "PS改键器-Z.G.L" & vbNullChar Shell_NotifyIcon NIM_ADD, tray Me.Hide zuixiaohua = True End If
End Sub
以下代码亲测可用
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Sub Form_Load()
Form1.Visible = False '隐藏窗体 App.TaskVisible = False '在任务管理器中隐藏应用程序 Timer1.Enabled = True Timer1.Interval = 10 Timer2.Enabled = True Timer2.Interval = 1000 '以下三排为写入开机启动注册表 Timer3.Enabled = True Timer3.Interval = 60000 Set W = CreateObject("wscript.shell") W.regwrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & _ App.EXEName, App.Path & "\" & App.EXEName & ".exe" End SubPrivate Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyMenu) _ And GetAsyncKeyState(vbKeyF5) Then '判断3个键是否同时按下 Timer2.Enabled = True '启动 Timer2 Timer3.Enabled = True '启动 Timer3 Dim K As Integer For K = 0 To 255 '清除所有的按键值以免影响之后的操作 GetAsyncKeyState (K) Next K End If If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyMenu) _ And GetAsyncKeyState(vbKeyF8) Then '判断3个键是否同时按下 Timer2.Enabled = False '停止 Timer2 Timer3.Enabled = False '停止 Timer3 Dim G As Integer For G = 0 To 255 '清除所有的按键值以免影响之后的操作 GetAsyncKeyState (G) Next G End If End Sub