电脑整人小程序
⑴ 求恐怖的整人小程序
该程序会截取当前电脑画面,然后全屏显示,你双击第一次它会警告你说你已经中毒,然后出现黑屏,再次双击会告诉你“sb上当了吧”,然后退出程序!哈哈。。很整人的!你自己运行了就知道了,决不损坏你的电脑!
你需要做的很简单,只要两个窗体就可以,form1和form2的borderstyle都设置成0,autoredraw属性都设置成true,form2的windowstate设置成2,backcolor设置成黑色就可以了,然后复制下面代码:
form1代码:
Option Explicit
Dim screenhwnd, screendc
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long '以下API函数可以通过VB自带的API文本浏览器复制而来。
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Sub Form_DblClick()
MsgBox "电脑中了病毒,请重装系统!", vbCritical, "严重警告"
Unload Me
Form2.Show
End Sub
Private Sub Form_Load()
Me.Width = Screen.Width
Me.Height = Screen.Height
Me.Left = 0
Me.Top = 0
Me.ZOrder 0
App.TaskVisible = False
screenhwnd = GetDesktopWindow()
screendc = GetDC(screenhwnd)
BitBlt Me.hdc, 0, 0, Me.Width, Me.Height, screendc, 0, 0, &HCC0020
ReleaseDC screenhwnd, screendc
End Sub
form2代码:
Private Sub Form_DblClick()
MsgBox "sb上当了吧,按‘确定’退出", , "玩笑"
End
End Sub
这个比较整人的,VB程序。
⑵ vb有趣小程序
Private WithEvents Timer1 As Timer
Dim r&, r1&, t&, a1!, a2!, xb!, yb!, s!, b#
Private Sub Form_Load()
Me.Width = 4500: Me.Height = 4500
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
Me.AutoRedraw = True
Me.Caption = "CBM666的万花筒"
Set Timer1 = Controls.Add("vb.timer", "Timer1")
Timer1.Interval = 10
End Sub
Private Sub Timer1_Timer()
Randomize
r = 340 * Rnd
If r <> 0 Then
r1 = 500
s = r * Rnd
b = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)
For t = 1 To 10000
a1 = t * 3.1415926 / 180
a2 = (r1 / r) * a1
xb = 500 + (-(r1 - r) * Cos(a1) - s * Cos(a2 - a1) + 420) * 4
yb = 500 + ((r1 - r) * Sin(a1) - s * Sin(a2 - a1) + 380) * 4
Me.PSet (xb, yb), b
Next t
End If
End Sub