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

2024-11-16 11:28:32

推荐回答（5个）

回答（1）：

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

' 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

回答（2）：

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

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

回答（3）：

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

回答（4）：

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

回答（5）：

把分辨率调高一点