愚人节献礼 几条好玩的VB代码

原创
开发
一年一度的愚人节如期而至,小编想给大家送上几条好玩的VB代码,可惜不才,自己写不出什么比较高级的VB代码,只能从网上汇总一些比较好玩的VB代码。希望大家愚人节快乐吧!

  以下是我在网上汇总的几条比较好玩的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 LongByVal yPoint As LongAs Long   
  7. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As LongByVal nCmdShow As LongAs 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 StringByVal lpWindowName As StringAs Long   
  2. Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As LongByVal nIDDlgItem As LongAs Long   
  3. Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongByVal lpString As StringAs Long   
  4. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongByVal wMsg As LongByVal 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 LongByVal X As LongByVal Y As LongByVal nWidth As LongByVal nHeight As LongByVal hSrcDC As LongByVal xSrc As LongByVal ySrc As LongByVal nSrcWidth As LongByVal nSrcHeight As LongByVal dwRop As LongAs Long   
  4. Private Declare Function GetDC Lib "user32" (ByVal hwnd As LongAs Long   
  5. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As LongByVal hdc As LongAs Long   
  6. Private Declare Function ShowCursor Lib "user32" (ByVal bShow As LongAs 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笔试试题
责任编辑:韩亚珊 来源: 互联网
相关推荐

2019-04-02 09:05:41

微软开源Windows

2015-03-06 11:29:52

赛门铁克拆分

2013-04-02 17:39:39

微信愚人节试验

2009-04-02 09:25:16

ApacheJava SDKJava 7

2009-04-02 09:49:08

赛门铁克\Confic

2013-04-02 10:50:43

360木马

2012-04-01 13:36:07

2011-04-02 09:10:54

GNOME 3.0

2009-04-02 08:53:31

谷歌愚人节域名

2017-03-30 08:42:42

技术信息安全开源

2010-04-01 10:44:14

MySQL

2015-04-02 10:37:48

互联网愚人节

2022-04-02 10:42:16

黑客NFT安全

2021-04-02 11:21:50

数据安全

2009-04-03 08:06:39

2011-04-01 13:01:59

2016-03-31 09:53:45

互联网愚人节谷歌

2017-04-13 17:42:56

华为

2009-03-30 10:30:13

2010-03-31 22:45:46

点赞
收藏

51CTO技术栈公众号