Click Me……

2010-08-22

TechCoding

参考经典的“ClickMe”。

'Form1 的 BorderStyle=0
'Form1 里面
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 GetDesktopWindow Lib "user32"() As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

Private Sub Form_Load
    Form1.Height = Screen.Height
    Form1.Width = Screen.Width
    Form1.Top = 0
    Form1.Left = 0
    Me.AutoRedraw = True
    BitBlt Form1.hDC, 0, 0, Screen.Width, Screen.Height, GetDC(GetDesktopWindow), 0, 0, vbSrcCopy
End Sub

'Form1 有一个 Timer（Timer1），Interval=1
Private Sub Timer1_Timer()
    Form2.Show 1
    Timer1.Enabled = False
End Sub

'Form2 里面
'Form2 的 BorderStyle=0
'设置 Form2 的 KeyPreview 为 True，否则……运行时就真的惨了……
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.Left = Random(Screen.Width - Me.Width)
    Me.Top = Random(Screen.Height - Me.Height)
End Sub

Private Function Random(ByVal Number) As Long
    Random = CLng(Rnd * Number + 1)
End Function

'如果 KeyPreview=False，就不会触发这个事件了，就……
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        MsgBox "哈哈,这是专门给你的 SURPRISE!", vbInformation
        End
    End If
End Sub

'Form2 有一个 Label（Label1），Caption="点我"，Left=0,Top=0,AutoSize=True,字体……随便吧，反正自动调整。
Private Sub Form_Load()
    Me.Height = Label1.Height + Me.Height - Me.SacleHeight
    Me.Width = Label1.Width + Me.Width - Me.ScaleWidth
End Sub

呵呵，这个还是可以用任务管理器终结的，因为还没有 SetWindowPos。不用那么毒了。

看起来就像是电脑瞬间就不能响应了（截屏了），而且必须“点我”才能恢复正常。

以上代码在本机测试通过。按 Escape 键退出。