重赏！vb 保存picturebox中的内容为图片

你的要求太高了，被遮挡的部分没有办法保存，其它条件可实现，模块代码：

' General functions:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' GDI functions:
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 Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
' Creates a memory DC
Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hDC As Long) As Long
' Creates a bitmap in memory:
Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hDC As Long, _
ByVal nWidth As Long, ByVal nHeight As Long) As Long
' Places a GDI Object into DC, returning the previous one:
Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long
' Deletes a GDI Object:
Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

' Clipboard functions:
Private Declare Function OpenClipboard Lib "USER32" _
(ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long
Private Declare Function SetClipboardData Lib "USER32" _
(ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "USER32" () As Long
Private Const CF_BITMAP = 2

Public Function CopyEntirePicture(ByRef objFrom As Object) As Boolean
Dim lhDC As Long
Dim lhBMP As Long
Dim lhBMPOld As Long
Dim lWidthPixels As Long
Dim lHeightPixels As Long

' Create a DC compatible with the object we're copying
' from:
lhDC = CreateCompatibleDC(objFrom.hDC)
If (lhDC <> 0) Then
' Create a bitmap compatible with the object we're
' copying from:
lWidthPixels = objFrom.ScaleX( _
objFrom.ScaleWidth, _
objFrom.ScaleMode, _
vbPixels)
lHeightPixels = objFrom.ScaleY( _
objFrom.ScaleHeight, _
objFrom.ScaleMode, _
vbPixels)
lhBMP = CreateCompatibleBitmap(objFrom.hDC, _
lWidthPixels, lHeightPixels)
If (lhBMP <> 0) Then
' Select the bitmap into the DC we have created,
' and store the old bitmap that was there:
lhBMPOld = SelectObject(lhDC, lhBMP)

' Copy the contents of objFrom to the bitmap:
BitBlt lhDC, 0, 0, lWidthPixels, lHeightPixels, _
objFrom.hDC, 0, 0, SRCCOPY

' Remove the bitmap from the DC:
SelectObject lhDC, lhBMPOld

' Now set the clipboard to the bitmap:
OpenClipboard 0
EmptyClipboard
SetClipboardData CF_BITMAP, lhBMP
CloseClipboard

' We don't delete the Bitmap here - it is now owned
' by the clipboard and Windows will delete it for us
' when the clipboard changes or the program exits.
End If

' Clear up the device context we created:
DeleteObject lhDC
End If
End Function

Form1窗体代码：

Private Sub Command1_Click()
CopyEntirePicture Picture1
SavePicture Clipboard.GetData(vbCFBitmap), "c:\1.bmp"
End Sub

把图片显示方式调成 缩放试试

或者 载入前先读取图片的宽高 然后把窗口 和控件的 大小自动调节 可以试试

“picturebox的大小超出窗体大小，所以一部分是看不到的……”电话装修公司把窗口凿宽点~或者你走到外面看进来不就看到了？

Picture1.AutoRedraw = False
Set Picture1.Picture = Picture1.Image
SavePicture Picture1.Picture, App.Path & "\123.bmp"
这样试试

把分辨率调高一点