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

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

[[20994]]

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

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 WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long   
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long   
Dim a(50)  As Long   
Dim I As Integer   
Dim flag As Boolean   
 
Private Sub Command1_Click()   
flag = True   
MsgBox "都叫你别冲动了.重启吧!"   
End   
End Sub   
 
Private Sub Form_Load()   
I = 0   
flag = fase   
End Sub   
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)   
Text1 = "小龙提醒你,别激动.!"   
Cancel = True   
End Sub   
 
Private Sub Timer1_Timer()   
Dim lg As Long   
On Error Resume Next   
Dim curhWnd As Long      'Current hWnd   
Dim lp As POINTAPI   
If flag = False Then Exit Sub   
I = I + 1   
If I < 50 Then   
        ' Initialize point structure:   
        Call GetCursorPos(lp)   
         ' Which window is the mouse cursor over?   
      curhWnd = WindowFromPoint(lp.x, lp.y)   
      a(I) = curhWnd   
      lg = ShowWindow(a(I), False)   
Else   
     For j = 1 To 50   
      lg = ShowWindow(a(j), True)   
     Next j   
End If   
End Sub 

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

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long   
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long   
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long   
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   
Private Const BM_CLICK = &HF5   
Private Sub Form_Load()   
Dim h1 As Long, h2 As Long   
h1 = FindWindow("Shell_TrayWnd", vbNullString)   
If h1 <> 0 Then   
h2 = GetDlgItem(h1, &H130)   
If h2 <> 0 Then   
SetWindowText h2, "小龙" '这里可以修改自己的文字   
SendMessage h2, BM_CLICK, 0, ByVal 0&   
End If   
End If   
End Sub 

　　3. 翻转屏幕代码

Option Explicit   
Dim W As Long, H As Long   
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   
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long   
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long   
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long   
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source   
Private Sub Form_Load()   
   Dim DC As Long   
   Me.Move 0, 0, Screen.Width, Screen.Height   
   W = Screen.Width / 15: H = Screen.Height / 15   
   ShowCursor False   
   Me.Visible = True   
   DC = GetDC(0)   
   StretchBlt Me.hdc, W - 1, H - 1, -W, -H, DC, 0, 0, W, H, SRCCOPY   
   ReleaseDC 0, DC   
End Sub   
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)   
If Button = 1 Then Unload Me   
End Sub   
Private Sub Form_Unload(Cancel As Integer)   
   ShowCursor True   
End Sub   
Private Sub Timer1_Timer()   
StretchBlt Me.hdc, W - 1, H - 1, -W, -H, Me.hdc, 0, 0, W, H, SRCCOPY   
Me.Refresh   
End Sub 

　　4. “你笨不笨”代码

Option Explicit   
Private Sub Command1_GotFocus()   
Command2.SetFocus   
End Sub   
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)   
Randomize Timer   
With Me   
   Command1.Move Rnd * (.ScaleWidth - Command1.Width), Rnd * (.ScaleHeight - Command1.Height)   
End With   
End Sub   
Private Sub Command2_Click()   
MsgBox "我笨！"   
End   
End Sub   
Private Sub Form_Load()   
Me.AutoRedraw = True   
Me.FontSize = 30   
Me.Print "你笨不笨？"   
Command1.Caption = "不笨"   
Command2.Caption = "笨"   
End Sub   
Private Sub Form_Unload(Cancel As Integer)   
Cancel = 1   
End Sub 

【编辑推荐】

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