弱弱的问！

Question

小弟想在vb中点击“保存“按钮时，将整个界面的图像都保存到画图板中，类似于键盘上的全屏拷贝的功能，请问该如何才能实现？有兄弟做过这样的东西吗？能不能给个参考！

Answer 1

买几本参考资料,比如说 <<VB世界2002>>,<<程序员大本营>>等等,都含有光盘,有丰富原代码.一定可以找到你需要的.我认为你的问题应该不是很难处理,可能是大家太忙的原因. UP

Answer 2

VB支持的图像文件格式不多，你就用BMP吧，你把要何存的东西都做到一个pictrue容器里面，你保存的时候，写一个代码就ＯＫ，不过就是ＢＭＰ格式的，别的格式要写更多的代码，保存的代码非常简单，ＰＩＣＴＲＵＥ。ＳＡＶＥ　文件名就可以了，你试试看，记得给分，

Answer 3

有抓屏API函数的。我得过一会给你找一找，现在忙。

Answer 4

截取屏幕图像
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPrivate Sub Form_Load()
Dim hBitmap As Integer
Me.AutoRedraw = True
hBitmap = CreateCompatibleBitmap(Me.hdc, 0, 0)
SelectObject Me.hdc, hBitmap
End Sub ===================================================声明：
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, 
ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) 
As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As 
Long, ByVal hMem As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, 
ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc 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 CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal 
lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As 
String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As 
Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc 
As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
函数：
Sub ScrnCap(Lt, Top, Rt, Bot)
rWidth = Rt - Lt
rHeight = Bot - Top
SourceDC = CreateDC("DISPLAY", 0, 0, 0)
DestDC = CreateCompatibleDC(SourceDC)
BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
SelectObject DestDC, BHandle
BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Lt, Top, &HCC0020
Wnd = Screen.ActiveForm.hwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub以下的示例把屏幕图象捕捉后，放到Picture1 中。
Sub Command1_Click()
Form1.Visible = False
ScrnCap 0, 0, 640, 480
Form1.Visible = True
picture1 = Clipboard.GetData()
End Sub

Answer 5

在VB下利用API函数Bitblt可以将屏幕或者窗口上的图像拷贝到VB中的PictureBox对象中，但是如果简单地利用PictureBox的SavePicture函数来保存图像，会发现什么也保存不了。这篇文章就是介绍如何捕获并利用Windows下的OLE API函数保存图像。
　　首先来看源程序，先建立一个新的工程文件，然后在Form1中加入5个CommandButton对象和一个PictureBox对象，然后在Form1中加入以下代码：
　　Option Explicit
　　Option Base 0
　　Private Type PALETTEENTRY
　　peRed As Byte
　　peGreen As Byte
　　peBlue As Byte
　　peFlags As Byte
　　End Type
　　Private Type LOGPALETTE
　　palVersion As Integer
　　palNumEntries As Integer
　　palPalEntry(255) As PALETTEENTRY
　　End Type
　　Private Type GUID
　　Data1 As Long
　　Data2 As Integer
　　Data3 As Integer
　　Data4(7) As Byte
　　End Type
　　Private Const RASTERCAPS As Long = 38
　　Private Const RC_PALETTE As Long = ＆H100
　　Private Const SIZEPALETTE As Long = 104
　　Private Type RECT
　　Left As Long
　　Top As Long
　　Right As Long
　　Bottom As Long
　　End Type
　　Private Declare Function CreateCompatibleDC Lib “GDI32" (ByVal hDC As Long) As Long
　　Private Declare Function CreateCompatibleBitmap Lib “GDI32" (ByVal hDC As Long, _
　　ByVal nWidth As Long, ByVal nHeight As Long) As Long
　　Private Declare Function GetDeviceCaps Lib “GDI32" (ByVal hDC As Long, ByVal _iCapabilitiy As Long) As Long
　　Private Declare Function GetSystemPaletteEntries Lib“GDI32" (ByVal hDC As Long, _ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries _
　　As PALETTEENTRY) As Long
　　Private Declare Function CreatePalette Lib “GDI32" (lpLogPalette As LOGPALETTE) _
　　As Long 
　　Private Declare Function SelectObject Lib “GDI32" (ByVal hDC As Long, ByVal hObject _
　　As Long) As Long
　　Private Declare Function BitBlt Lib “GDI32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
　　ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop _
　　（As Long) As Long
　　Private Declare Function DeleteDC Lib “GDI32" (ByVal hDC As Long) As Long
　　Private Declare Function GetForegroundWindow Lib “USER32" () As Long
　　Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette _
　　As Long, ByVal bForceBackground As Long) As Long
　　Private Declare Function RealizePalette Lib “GDI32" (ByVal hDC As Long) As Long
　　Private Declare Function GetWindowDC Lib “USER32" (ByVal hWnd As Long) As Long
　　Private Declare Function GetDC Lib “USER32" (ByVal hWnd As Long) As Long
　　Private Declare Function GetWindowRect Lib “USER32" (ByVal hWnd As Long, lpRect As _
　　RECT) As Long
　　Private Declare Function ReleaseDC Lib “USER32" (ByVal hWnd As Long, ByVal hDC As _
　　Long) As Long
　　Private Declare Function GetDesktopWindow Lib “USER32" () As Long
　　Private Type PicBmp
　　Size As Long
　　Type As Long
　　hBmp As Long
　　hPal As Long
　　Reserved As Long
　　End Type
　　Private Declare Function OleCreatePictureIndirect Lib“olepro32.dll" (PicDesc As _
　　PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
　　'捕捉整个屏幕
　　Private Sub Command1_Click()
　　Set Picture1.Picture = CaptureScreen()
　　End Sub
　　'在两秒钟后捕捉当前的活动窗口
　　Private Sub Command2_Click()
　　MsgBox“当你关闭这个对话框两秒钟之后程序会捕捉处于活动状态的窗口。"
　　'等待两秒钟
　　Dim EndTime As Date
　　EndTime = DateAdd(“s", 2, Now)
　　Do Until Now > EndTime
　　DoEvents
　　Loop
　　Set Picture1.Picture = CaptureActiveWindow()
　　Me.SetFocus
　　End Sub
　　Private Sub Command3_Click()
　　Set Picture1.Picture = Nothing
　　End Sub
　　Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
　　Dim r As Long
　　Dim Pic As PicBmp
　　Dim IPic As IPicture
　　Dim IID_IDispatch As GUID
　　'填充IDispatch界面
　　With IID_IDispatch
　　.Data1 = ＆H20400
　　.Data4(0) = ＆HC0
　　.Data4(7) = ＆H46
　　End With
　　'填充Pic
　　With Pic
　　.Size = Len(Pic)
　　' Pic结构长度
　　.Type = vbPicTypeBitmap
　　' 图像类型
　　.hBmp = hBmp
　　' 位图句柄
　　.hPal = hPal 
　　' 调色板句柄
　　End With
　　’建立Picture图像
　　r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
　　'返回Picture对象
　　Set CreateBitmapPicture = IPic
　　End Function
　　Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal _
　　LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc _
　　As Long) As Picture
　　Dim hDCMemory As Long
　　Dim hBmp As Long
　　Dim hBmpPrev As Long
　　Dim r As Long
　　Dim hDCSrc As Long
　　Dim hPal As Long
　　Dim hPalPrev As Long
　　Dim RasterCapsScrn As Long
　　Dim HasPaletteScrn As Long
　　Dim PaletteSizeScrn As Long
　　Dim LogPal As LOGPALETTE
　　If Client Then
　　hDCSrc = GetDC(hWndSrc)
　　Else
　　hDCSrc = GetWindowDC(hWndSrc)
　　End If
　　hDCMemory = CreateCompatibleDC(hDCSrc)
　　hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
　　hBmpPrev = SelectObject(hDCMemory, hBmp)
　　'获得屏幕属性
　　RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
　　HasPaletteScrn = RasterCapsScrn And RC_PALETTE
　　PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
　　'如果屏幕对象有调色板则获得屏幕调色板
　　If HasPaletteScrn And (PaletteSizeScrn = 256) Then
　　'建立屏幕调色板的拷贝
　　LogPal.palVersion = ＆H300
　　LogPal.palNumEntries = 256
　　r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
　　hPal = CreatePalette(LogPal)
　　'将新建立的调色板选如建立的内存绘图句柄中
　　hPalPrev = SelectPalette(hDCMemory, hPal, 0)
　　r = RealizePalette(hDCMemory)
　　End If
　　'拷贝图像
　　r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)
　　hBmp = SelectObject(hDCMemory, hBmpPrev)
　　If HasPaletteScrn And (PaletteSizeScrn = 256) Then
　　hPal = SelectPalette(hDCMemory, hPalPrev, 0)
　　End If
　　'释放资源
　　r = DeleteDC(hDCMemor

Answer 6

哎！来晚了一步。被楼上的先回答了。楼上的程序我还没有看，不过应该可以。如果不行的话，楼主，你就在CSDN的VB的基础类里面搜索“截屏”就可以了。