求一个很多空文件夹,打开到最后是桌面开满玫瑰花的小程序

求一个很多空文件夹,打开到最后是桌面开满玫瑰花的小程序,第1张

这个你自己 做一个好了,

比如你建立一个文件夹,在里面再建立一个…………,依次建立,然后下个开满玫瑰花的程序,把程序的图标换成文件夹的,这样人家以为还是文件夹

改ico的软件也很多, 不知道怎么做的可以联系我哦!

桌面涂鸦VB程序代码

Option Explicit

Public Type POINTAPI

x As Long

y As Long

End Type

Public nXn As Long

Public gfqw As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public sbsb As POINTAPI

Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lparam As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)

Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long

Public Type MOUSEMSGS

x As Long'x座标

y As Long'y座标

a As Long

b As Long

time As Long 'Window运行时间

End Type

Public Const WH_MOUSE_LL = 14

Public Const MB_OK = &H0&

Public Const MB_ICONASTERISK = &H40&

Public Type MSLLHOOKSTRUCT

pt As POINTAPI

mouseData As Long

Flags As Long

time As Long

dwExtraInfo As Long

End Type

Public hHook As Long

'-----------------------------------------

'消息

Public Const HC_ACTION = 0

Public Const HC_SYSMODALOFF = 5

Public Const HC_SYSMODALON = 4

'鼠标消息

Public Const WM_MOUSEMOVE = &H200

Public Const WM_LBUTTONDOWN = &H201

Public Const WM_LBUTTONUP = &H202

Public Const WM_LBUTTONDBLCLK = &H203

Public Const WM_RBUTTONDOWN = &H204

Public Const WM_RBUTTONUP = &H205

Public Const WM_RBUTTONDBLCLK = &H206

Public Const WM_MBUTTONDOWN = &H207

Public Const WM_MBUTTONUP = &H208

Public Const WM_MBUTTONDBLCLK = &H209

Public Const WM_MOUSEACTIVATE = &H21

Public Const WM_MOUSEFIRST = &H200

Public Const WM_MOUSELAST = &H209

Public Const WM_MOUSEWHEEL = &H20A

Public Declare Function GetActiveWindow Lib "user32" () As Long

Public MouseMsg As MOUSEMSGS '鼠标消息结构体

Public lHook As Long '勾子句柄

Public sbss As POINTAPI

'鼠标钩子函数

Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long

Dim typMHS As MSLLHOOKSTRUCT, pt As POINTAPI

If wParam = WM_MOUSEMOVE Then

Call CopyMemory(typMHS, ByVal lparam, LenB(typMHS))

pt = typMHS.pt

Debug.Print "mouse Cursor at " + CStr(pt.x) + "," + CStr(pt.y)

GetCursorPos sbsb

End If

If wParam = WM_LBUTTONDOWN Then

Form1.Timer2.Enabled = True

nXn = 2

GetCursorPos sbss

End If

If wParam = WM_RBUTTONDOWN Then

End If

If wParam = WM_LBUTTONUP Then '按下中间记下这个值,然后调用一个过程,我的鼠标没有中键,自己测试一下

Form1.Timer2.Enabled = False

HookProc = CallNextHookEx(hHook, nCode, wParam, lparam)

End If

End Function

'卸载勾子

Public Sub StopHook()

If lHook <>0 Then lHook = UnhookWindowsHookEx(lHook)

End Sub

'===================== 模块结束 ========================

Public Sub FreeHook()

If hHook <>0 Then

Call UnhookWindowsHookEx(hHook)

hHook = 0

End If

End Sub

Public Sub EnableHook()

If hHook = 0 Then

hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProc, App.hInstance, 0)

End If

End Sub

共3个版本,祝福语功能是我编进去的,要是早点看到的话,可以邦你改成屏幕飞花,或其它动画效果。

七夕快乐!

附:在线制做情人节FLASH动画礼盒:http://ad.anyad.cn/lover_1.php


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/yw/11170646.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-14
下一篇 2023-05-14

发表评论

登录后才能评论

评论列表(0条)

保存