模仿照相闪屏效果

Question

我想让点击一个按钮后，整个电脑屏幕突然闪一下，不知道是不是有这样的函数可以直接调用。
麻烦各位大侠指导指导

Answer 1

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
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 CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private bybits(1 To 16) As Byte
Private hBitmap As Long, hBrush As Long
Private hDesktopWnd As LongPrivate Sub Command1_Click()
    Dim rop As Long, res As Long
    Dim hdc5 As Long, width5 As Long, height5 As Long
    hdc5 = GetDC(0)
    width5 = Screen.Width \ Screen.TwipsPerPixelX
    height5 = Screen.Height \ Screen.TwipsPerPixelY
    rop = &HA000C9
    Call SelectObject(hdc5, hBrush)
    res = PatBlt(hdc5, 0, 0, width5, height5, rop)
    Call DeleteObject(hBrush)
    res = ReleaseDC(0, hdc5)
    waittime 0.5
    Dim aa As Long
    aa = InvalidateRect(0, 0, 1)
End SubPrivate Sub Form_Load()
    Dim ary
    Dim i As Long
    ary = Array(&H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, _
    &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0)
    For i = 1 To 16
        bybits(i) = ary(i - 1)
    Next i
    hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))
    hBrush = CreatePatternBrush(hBitmap)
    Picture1.ForeColor = RGB(0, 0, 0)
    Picture1.BackColor = RGB(255, 255, 255)
    Picture1.ScaleMode = 3
End Sub
Private Sub waittime(delay As Single)
        Dim starttime As Single
        starttime = Timer
        Do Until (Timer - starttime) > delay
        Loop
End Sub

Answer 2

使用BitBlt把黑屏覆盖一下桌面，1s后再恢复即可。

Answer 3

给你个思路....添加一个窗体,设置以下几个属性:一,边框为无.
二,颜色为白.
三,启动状态为最大化.然后,在这个窗体里加个定时器,时间设置为200毫秒左右吧,自己调.时间到了后就卸载这个白窗体.然后.....直接让这个窗体.Show就行了