高手帮忙,有关PictureBox里面的图像保存问题
高手帮忙:我的问题是这样的:在Form中引一个picturebox1控个,再在picturebox1控件里面再引入一个picturebox2控件,label1,textbox等,然后通过程序在picturebox2中画了一些图形,移动label1,textbox控件的位置,现在我要把picturebox1(包括picturebox2,lable,text,....)里面的所有图像保存为jpg/bmp形式的文件.
[解决办法]
http://zhidao.baidu.com/question/20086889.html
百度网友 "鲸无敌 "的代码,径调试无误,该代码已修改,可保存保存用picture的line,circle……方法绘制的图片或加载的图片。图片框内的按钮及标签控件无法保存,但通过函数方式显示于图片框的文字可保存:
Option Explicit
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 ' color table in RGBs
Private Const BITMAPTYPE = &H4D42
Private Const INVALID_HANDLE_VALUE = (-1)
Private Const GENERIC_WRITE = &H40000000
Private Const CREATE_ALWAYS = 2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private 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
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Declare Function CreateCompatibleDC Lib "gdi32 " (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32 " (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function DeleteDC Lib "gdi32 " (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32 " (ByVal hObject As Long) 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 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 CreateFile Lib "kernel32 " Alias "CreateFileA " (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32 " (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32 " (ByVal hObject As Long) As Long
Dim colvb As Long
Dim xx As Integer
Dim yy As Integer
Dim txt As String
Dim wp As Variant
Public Function xp(colvb As Variant, xx As Variant, yy As Variant, txt As Variant)
Picture1.ForeColor = colvb 'QBColor(14)
Picture1.CurrentX = xx
Picture1.CurrentY = yy
Picture1.Print txt '
End Function
Private Sub Command1_Click()
Dim hmemDC As Long
Dim hmemBMP As Long
Dim lpmemBits As Long
Dim bmp_info As BITMAPINFO
Dim hFile As Long
Dim bmpfile_info As BITMAPFILEHEADER
Dim lpBytesWritten As Long
Picture1.ScaleMode = vbPixels
With bmp_info.bmiHeader
.biSize = LenB(bmp_info.bmiHeader)
.biWidth = Picture1.ScaleWidth
.biHeight = Picture1.ScaleHeight
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
.biSizeImage = .biHeight * (((.biWidth * .biBitCount + 31) And &HFFFFFFE0) \ 8)
End With
hmemDC = CreateCompatibleDC(Picture1.hdc)
hmemBMP = CreateDIBSection(Picture1.hdc, bmp_info, DIB_RGB_COLORS, lpmemBits, 0, 0)
SelectObject hmemDC, hmemBMP
BitBlt hmemDC, 0, 0, bmp_info.bmiHeader.biWidth, bmp_info.bmiHeader.biHeight, Picture1.hdc, 0, 0, vbSrcCopy
'保存图片
hFile = CreateFile(App.Path & "\test.bmp ", GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If hFile <> INVALID_HANDLE_VALUE Then
With bmpfile_info
.bfType = BITMAPTYPE
.bfOffBits = 14 + bmp_info.bmiHeader.biSize
.bfSize = .bfOffBits + bmp_info.bmiHeader.biSizeImage
End With
WriteFile hFile, bmpfile_info.bfType, 2, lpBytesWritten, 0
WriteFile hFile, bmpfile_info.bfSize, 12, lpBytesWritten, 0
WriteFile hFile, bmp_info.bmiHeader, bmp_info.bmiHeader.biSize, lpBytesWritten, 0
WriteFile hFile, ByVal lpmemBits, bmp_info.bmiHeader.biSizeImage, lpBytesWritten, 0
CloseHandle hFile
End If
DeleteObject hmemBMP
DeleteDC hmemDC
End Sub
Private Sub Form_Load()
Dim i As Integer
Picture1.ForeColor = vbYellow
For i = 1 To 10
Picture1.Line (500, 500 * i)-(10500, 500 * i)
Next
For i = 1 To 21
Picture1.Line (500 * i, 500)-(500 * i, 5000)
Next
colvb = vbBlue
xx = 100
yy = 150
txt = "℃ "
wp = xp(colvb, xx, yy, txt)
yy = 350
txt = "100 "
wp = xp(colvb, xx, yy, txt)
xx = 200
yy = 1850
txt = "50 "
wp = xp(colvb, xx, yy, txt)
yy = 3350
xx = 300
txt = "0 "
wp = xp(colvb, xx, yy, txt)
xx = 100
yy = 4850
txt = "-50 "
wp = xp(colvb, xx, yy, txt)
xx = 0
yy = 6350
txt = "-100 "
wp = xp(colvb, xx, yy, txt)
xx = 10800 + 100
yy = 150
txt = "℃ "
wp = xp(colvb, xx, yy, txt)
yy = 350
txt = "100 "
wp = xp(colvb, xx, yy, txt)
xx = 10800 + 200
yy = 1850
txt = "50 "
wp = xp(colvb, xx, yy, txt)
yy = 3350
xx = 10800 + 300
txt = "0 "
wp = xp(colvb, xx, yy, txt)
xx = 10800 + 100
yy = 4850
txt = "-50 "
wp = xp(colvb, xx, yy, txt)
xx = 10800 + 0
yy = 6350
txt = "-100 "
wp = xp(colvb, xx, yy, txt)
End Sub