恶作剧的屏保
本来这是一个屏保的雏形，少了一些东西。在添加了开机隐藏和获取光标位置之后就变成了一个恶作剧了。运行程序会出现好多黑点，看不见程序界面，当把鼠标移到左上角时便可以看到界面了，可以进行设置和关闭等操作，娱乐，欢迎交流。
1。程序代码如下：因为代码较少，都在窗体模块中。
Private Declare Sub Sleep Lib "kernel32 " (ByVal dwMilliseconds As Long)
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
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
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Bsize As Long, Asize As Long
Private flag_daxiao As Long, flag_sudu As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
Private Type pointapi
x As Long
y As Long
End Type
'Private flag As Boolean
Private Sub pingbao()
'If flag Then
Dim M1 As Long, M2 As Long, N1 As Long, N2 As Long, ret As Long
Dim hDCMem As Long, hDCScreen As Long, hBitmap As Long
Dim sx As Integer, sy As Integer
sx = Screen.Width \ Screen.TwipsPerPixelX ' 以 pixel 为单位之萤幕宽
sy = Screen.Height \ Screen.TwipsPerPixelY ' 以 pixel 为单位之萤幕高
hDCScreen = GetDC(0) ' 取得萤幕 DC
hDCMem = CreateCompatibleDC(hDCScreen) ' 建立暂存区 DC
hBitmap = CreateCompatibleBitmap(hDCScreen, Bsize, Bsize) ' 建立点阵图
ret = SelectObject(hDCMem, hBitmap) ' 将点阵图设定给暂存区 DC
M1 = CInt(Rnd * sx \ Bsize)
N1 = CInt(Rnd * sy \ Bsize) ' (M1, N1) 为方块一
M2 = CInt(Rnd * sx \ Bsize)
N2 = CInt(Rnd * sy \ Bsize) ' (M2, N2) 为方块二
' 方块一与方块二互换
ret = BitBlt(hDCMem, 0, 0, Bsize, Bsize, hDCScreen, M1 * Bsize, N1 * Bsize, SRCCOPY)
ret = BitBlt(hDCScreen, M1 * Bsize, N1 * Bsize, Bsize, Bsize, hDCScreen, M2 * Bsize, N2 * Bsize, SRCCOPY)
ret = BitBlt(hDCScreen, M2 * Bsize, N2 * Bsize, Bsize, Bsize, hDCMem, 0, 0, SRCCOPY)
ret = ReleaseDC(0, hDCScreen) ' 释回萤幕 DC
ret = DeleteDC(hDCMem) ' 释回暂存区 DC
ret = DeleteObject(hBitmap) ' 释回点阵图， 一定要放在 DeleteDC 之後
'End If
End Sub
Private Sub Form_Load()
Form1.Visible = False
Bsize = CInt(Text1.Text)
flag_daxiao = Bsize
flag_sudu = 1000 / t1.Interval
End Sub
Private Sub Label3_Click()
Title$ = "数据检查对话框"
msg1$ = "请输入数值"
msg2$ = "请输入介于1到1000的数值"
Dim shuzhi As Long
If Not IsNumeric(Text1.Text) Then '对第一个文本框进行判断
r = MsgBox(msg1, 48, Title) '对话框
GoTo jieshu
End If
If Not IsNumeric(Text2.Text) Then '对第二个文本框进行判断
r1 = MsgBox(msg2, 48, Title) '对话框
GoTo jieshu
End If
If Not (CInt(Text2.Text) >= 1 And CInt(Text2.Text) <= 1000) Then
r3 = MsgBox(msg2, 48, Title) '对话框
GoTo jieshu
End If
Bsize = CInt(Text1.Text)
t1.Interval = 1000 / CInt(Text2.Text)
flag_daxiao = Bsize
flag_sudu = 1000 / t1.Interval
t1.Enabled = True
jieshu:
Text1.Text = Str(flag_daxiao)
Text2.Text = Str(flag_sudu)
End Sub
Private Sub t1_Timer()
Call pingbao
End Sub
Private Sub Timer1_Timer()
Dim po As pointapi
Dim a As Long
a = GetCursorPos(po)
If po.x < 5 And po.y < 5 Then
Form1.Show
End If
End Sub
具体可以见附件
恶作剧屏保.zip