用VB怎么摸拟xp关机效果、??锁定桌面,禁用系统热键,颜色过度为灰度!!

解决方案 »

  1.   

    网上的代码多得是,给你看看这个
    一个picturebox,两个按钮Option ExplicitPrivate Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End TypePrivate 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 LongPrivate bybits(1 To 16) As Byte
    Private hBitmap As Long, hBrush As Long
    Private hDesktopWnd As Long
    '将图变暗,如同待关机一般
    Private Sub Command1_Click()
    Dim rop As Long, res As Long
    Dim hdc5 As Long, width5 As Long, height5 As Long
    '如果只要让Picture1有效果将底下叁行unMark取代 hdc5, width5, height5叁个值
    'hdc5 = Picture1.hdc
    'width5 = Picture1.ScaleWidth
    'height5 = Picture1.ScaleHeight'底下叁行设定整个萤幕都暗下来
    hdc5 = GetDC(0)
    width5 = Screen.Width \ Screen.TwipsPerPixelX
    height5 = Screen.Height \ Screen.TwipsPerPixelYrop = &HA000C9 '与原图做and运算
    Call SelectObject(hdc5, hBrush)
    res = PatBlt(hdc5, 0, 0, width5, height5, rop)
    Call DeleteObject(hBrush)
    '如果只暗picture1则底下这一行要起来
    res = ReleaseDC(0, hdc5)
    End Sub
    '回复原本的画面
    Private Sub Command2_Click()
    Dim aa As Long
    '如果只暗picture1则底下这一行要unMark起来
    'Picture1.Refresh'如果只暗picture1则底下这一行要起来
    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
      

  2.   

    ls的那个代码是9X的,不是XP的………………