愚人节献礼 几条好玩的VB代码
创始人
2024-07-24 22:50:51
0

  以下是我在网上汇总的几条比较好玩的VB整人代码,希望大家在学习之余也能放松一下吧,愚人节快乐!

[[20994]]

  1. 关闭桌面所有窗口的代码

  1. Private Type POINTAPI   
  2.         x As Long   
  3.         y As Long   
  4. End Type   
  5. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long   
  6. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long   
  7. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long   
  8. Dim a(50)  As Long   
  9. Dim I As Integer   
  10. Dim flag As Boolean   
  11.  
  12. Private Sub Command1_Click()   
  13. flag = True   
  14. MsgBox "都叫你别冲动了.重启吧!"   
  15. End   
  16. End Sub   
  17.  
  18. Private Sub Form_Load()   
  19. I = 0   
  20. flag = fase   
  21. End Sub   
  22.  
  23. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)   
  24. Text1 = "小龙提醒你,别激动.!"   
  25. Cancel = True   
  26. End Sub   
  27.  
  28. Private Sub Timer1_Timer()   
  29. Dim lg As Long   
  30. On Error Resume Next   
  31. Dim curhWnd As Long      'Current hWnd   
  32. Dim lp As POINTAPI   
  33. If flag = False Then Exit Sub   
  34. I = I + 1   
  35. If I < 50 Then   
  36.         ' Initialize point structure:   
  37.         Call GetCursorPos(lp)   
  38.          ' Which window is the mouse cursor over?   
  39.       curhWnd = WindowFromPoint(lp.x, lp.y)   
  40.       a(I) = curhWnd   
  41.       lg = ShowWindow(a(I), False)   
  42. Else   
  43.      For j = 1 To 50   
  44.       lg = ShowWindow(a(j), True)   
  45.      Next j   
  46. End If   
  47. End Sub 

2. 修改开始菜单名字的代码

  1. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long   
  2. Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long   
  3. Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long   
  4. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long   
  5. Private Const BM_CLICK = &HF5   
  6. Private Sub Form_Load()   
  7. Dim h1 As Long, h2 As Long   
  8. h1 = FindWindow("Shell_TrayWnd", vbNullString)   
  9. If h1 <> 0 Then   
  10. h2 = GetDlgItem(h1, &H130)   
  11. If h2 <> 0 Then   
  12. SetWindowText h2, "小龙" '这里可以修改自己的文字   
  13. SendMessage h2, BM_CLICK, 0, ByVal 0&   
  14. End If   
  15. End If   
  16. End Sub 

  3. 翻转屏幕代码

  1. Option Explicit   
  2. Dim W As Long, H As Long   
  3. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long   
  4. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long   
  5. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long   
  6. Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long   
  7. Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source   
  8. Private Sub Form_Load()   
  9.    Dim DC As Long   
  10.    Me.Move 0, 0, Screen.Width, Screen.Height   
  11.    W = Screen.Width / 15: H = Screen.Height / 15   
  12.    ShowCursor False   
  13.    Me.Visible = True   
  14.    DC = GetDC(0)   
  15.    StretchBlt Me.hdc, W - 1, H - 1, -W, -H, DC, 0, 0, W, H, SRCCOPY   
  16.    ReleaseDC 0, DC   
  17. End Sub   
  18. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)   
  19. If Button = 1 Then Unload Me   
  20. End Sub   
  21. Private Sub Form_Unload(Cancel As Integer)   
  22.    ShowCursor True   
  23. End Sub   
  24. Private Sub Timer1_Timer()   
  25. StretchBlt Me.hdc, W - 1, H - 1, -W, -H, Me.hdc, 0, 0, W, H, SRCCOPY   
  26. Me.Refresh   
  27. End Sub 

  4. “你笨不笨”代码

  1. Option Explicit   
  2. Private Sub Command1_GotFocus()   
  3. Command2.SetFocus   
  4. End Sub   
  5. Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)   
  6. Randomize Timer   
  7. With Me   
  8.    Command1.Move Rnd * (.ScaleWidth - Command1.Width), Rnd * (.ScaleHeight - Command1.Height)   
  9. End With   
  10. End Sub   
  11. Private Sub Command2_Click()   
  12. MsgBox "我笨!"   
  13. End   
  14. End Sub   
  15. Private Sub Form_Load()   
  16. Me.AutoRedraw = True   
  17. Me.FontSize = 30   
  18. Me.Print "你笨不笨?"   
  19. Command1.Caption = "不笨"   
  20. Command2.Caption = "笨"   
  21. End Sub   
  22. Private Sub Form_Unload(Cancel As Integer)   
  23. Cancel = 1   
  24. End Sub 

【编辑推荐】

  1. 利用Visual Basic命令操作文件
  2. 微软于Visual Basic开发者大会揭露VB走向
  3. 2011年3月计算机二级VB笔试试题

相关内容

热门资讯

如何允许远程连接到MySQL数... [[277004]]【51CTO.com快译】默认情况下,MySQL服务器仅侦听来自localhos...
如何利用交换机和端口设置来管理... 在网络管理中,总是有些人让管理员头疼。下面我们就将介绍一下一个网管员利用交换机以及端口设置等来进行D...
施耐德电气数据中心整体解决方案... 近日,全球能效管理专家施耐德电气正式启动大型体验活动“能效中国行——2012卡车巡展”,作为该活动的...
Windows恶意软件20年“... 在Windows的早期年代,病毒游走于系统之间,偶尔删除文件(但被删除的文件几乎都是可恢复的),并弹...
20个非常棒的扁平设计免费资源 Apple设备的平面图标PSD免费平板UI 平板UI套件24平图标Freen平板UI套件PSD径向平...
德国电信门户网站可实时显示全球... 德国电信周三推出一个门户网站,直观地实时提供其安装在全球各地的传感器网络检测到的网络攻击状况。该网站...
为啥国人偏爱 Mybatis,... 关于 SQL 和 ORM 的争论,永远都不会终止,我也一直在思考这个问题。昨天又跟群里的小伙伴进行...
《非诚勿扰》红人闫凤娇被曝厕所... 【51CTO.com 综合消息360安全专家提醒说,“闫凤娇”、“非诚勿扰”已经被黑客盯上成为了“木...