如何用VB程序将屏幕上看到的内容切成图片保存

Question

请教各位,如何用VB程序将屏幕上看到的内容切成图片保存,比如,将正在运行的表单的样子用图片方式保存.要在程序运行中执行.

Answer 1

zyl910(910，这是ＶＢ６的语言吗

Answer 2

Capture Screen or Active Window:http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=1621&lngWId=1

Answer 3

TechnoFantasy(冰儿马甲，先谢谢你，不过你给的方式好像切的地方不对，如何控制切的位置啊？刚才切下来的不是活动表单，而是表单的一半

Answer 4

deskHwnd=getdc(0)
bitblt deskhwnd,0,0,screen.scalewidth,screen.scaleheight,0,0,picturebox.scalewidth,picturebox.scaleheight,vbsrcopy
savepicture picturebox.image,app.path+"\screen.bmp"

Answer 5

http://blog.csdn.net/lihonggen0/archive/2004/11/13/180394.aspx

Answer 6

TechnoFantasy(冰儿马甲，先谢谢你，不过你给的方式好像切的地方不对，如何控制切的位置啊？刚才切下来的不是活动表单，而是表单的一半
--------------------------------------
自己算好bitblt的坐标参数就行了

Answer 7

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public 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
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Const DIB_RGB_COLORS = 0 '  color table in RGBs
Public Const SRCCOPY = &HCC0020  ' (DWORD) dest = source
Public Const HORZRES = 8           ;  '  Horizontal width in pixels
Public Const VERTRES = 10         &nbs p; '  Vertical width in pixels
Public Const IsBitmapFile = &H4D42
Public Const BI_RGB = 0&
Public Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type
Public Type BITMAPFILEHEADER
        bfType As Integer
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
End Type
Public Type BITMAPINFOHEADER '40 bytes
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type
Public Type BITMAP '14 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type
Public Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End TypePublic Bif As BITMAPFILEHEADER
Public Bih As BITMAPINFOHEADER
Public Bmp As BITMAP
Public BmpInfo As BITMAPINFO
Public BmpHeight As Long
Public BmpWidth As Long
Public BmpHandle As Long
Public BmpBinary() As Byte
Public BmpSize As LongPublic DC As Long
Public Mem As Long
Public Sub CatchDisplay()DC = GetDC(0) '获取整个屏幕的设备场景
BmpWidth = GetDeviceCaps(DC, HORZRES)
BmpHeight = GetDeviceCaps(DC, VERTRES)
BmpHandle = CreateCompatibleBitmap(DC, BmpWidth, BmpHeight)
Mem = CreateCompatibleDC(DC)
SelectObject Mem, BmpHandle
 BitBlt Mem, 0, 0, BmpWidth, BmpHeight, DC, 0, 0, SRCCOPY
SetAndSaveTheBitmap BmpHandle
Form1.Pic2.Width = BmpWidth * 18
Form1.Pic2.Height = BmpHeight * 18
BitBlt Form1.Pic2.hDC, 0, 0, BmpWidth, BmpHeight, Mem, 0, 0, SRCCOPY
End Sub
Public Sub SetAndSaveTheBitmap(BmpHandle As Long)
GetObject BmpHandle, Len(Bmp), Bmp
BmpSize = Bmp.bmWidthBytes * Bmp.bmHeight
With Bih
  .biBitCount = Bmp.bmBitsPixel
  .biClrImportant = 0
  .biClrUsed = 0
  .biCompression = BI_RGB
  .biHeight = Bmp.bmHeight
  .biPlanes = 1
  .biSize = Len(Bih)
  .biSizeImage = BmpSize
  .biWidth = Bmp.bmWidth
  .biXPelsPerMeter = 0
  .biYPelsPerMeter = 0
End With
With Bif
  .bfOffBits = 54
  .bfReserved1 = .bfReserved2 = 0
  .bfType = IsBitmapFile
  .bfSize = 54 + BmpSize
End With
BmpInfo.bmiHeader = Bih
ReDim BmpBinary(1 To BmpSize) As Byte
GetDIBits Mem, BmpHandle, 0, BmpInfo.bmiHeader.biHeight, BmpBinary(1), BmpInfo, DIB_RGB_COLORS
Open "c:\temp.bmp" For Binary As #1
Put #1, , Bif
Put #1, , Bih
Put #1, , BmpBinary()
Close #1
End Sub