Question

如何在VB中实现截取当前屏幕并将其设为桌面背景？

如题，程序越简单越好，谢谢了！

Answer 1

'句柄 Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long '检查按键 Private Declare Function GetAsyncKeyState Lib "user32 " (ByVal vKey As Long) As Integer '延时 Private Declare Sub Sleep Lib "kernel32 " (ByVal dwMilliseconds As Long) Const VK_SNAPSHOT = &H2C Const SPI_SETDESKWALLPAPER = 20 Const SPIF_SENDWININICHANGE = &H2 Const SPIF_UPDATEINIFILE = &H1 Private Sub Timer1_Timer() If GetAsyncKeyState(VK_SNAPSHOT) <> 0 Then Me.Hide Me.AutoRedraw = True Sleep 100 BitBlt Me.hDC, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, vbSrcCopy sFile$ = "C:\Documents and Settings\Administrator\Application Data\Microsoft\Internet Explorer\Internet Explorer Wallpaper.bmp" SavePicture Me.Image, sFile Me.Show Me.Cls Label1.Caption = "截图完成！" Sleep 500 re = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "C:\Documents and Settings\Administrator\Application Data\Microsoft\Internet Explorer\Internet Explorer Wallpaper.bmp", 0) Label1.Caption = "贴墙完成！" End If End Sub