私有類型GUID
Data1壹樣長
整數形式的數據2
整數形式的數據3
以字節表示的數據4(0至7)
結束類型
私有類型GdiplusStartupInput
GdiplusVersion壹樣長
長時間調試事件回調
SuppressBackgroundThread為Long
SuppressExternalCodecs壹樣長
結束類型
私有類型編碼器參數
GUID作為GUID
NumberOfValues As Long
類型壹樣長
值壹樣長
結束類型
私有類型編碼器參數
算作長
參數作為編碼參數
結束類型
私有聲明函數GDIPlus startup Lib " GDIPlus "( token為Long，inputbuf為GdiplusStartupInput，可選ByVal _
outputbuf As Long = 0) As Long
私有聲明函數GdiplusShutdown Lib " GDIPlus "(ByVal token As Long)
私有聲明函數GdipCreateBitmapFromHBITMAP Lib " GDIPlus "(ByVal hbm為Long，ByVal hPal為Long，BITMAP為Long)為Long
私有聲明函數GdipDisposeImage Lib " GDIPlus "(ByVal Image As Long)
私有聲明函數GdipSaveImageToFile Lib " GDIPlus "( ByVal Image為Long，ByVal filename為Long，clsidEncoder為_
GUID，encoderParams As Any)壹樣長
私有聲明函數CLSIDFromString Lib " ole32 "(ByVal string為Long，id為GUID)為Long
私有聲明函數CopyMemory Lib "kernel32 "別名" RtlMoveMemory" (dest As Any，src As Any，ByVal CB As Long)Long
'*************************************************************************
* *由laviewpbt提供
* *函數名:SavePic
* *輸入:pic(STD picture)-圖像句柄。
* *:文件名(字符串)-保存路徑
* *:質量(字節)-jpg圖像質量
* *:tiff _ color depth(long)-TTF格式的顏色深度。
* *: tiff _ compression (long)-TTF格式壓縮比。
* *產出:無
* *功能描述:以JPG、TIFF、PNG、GIF和BMP格式保存圖像。
* *日期:2007年8月4日
* *修訂人:BEN
* *日期:2005年4月4日
'*************************************************************************
public Sub save pic(ByVal PICT As STD picture，ByVal filename As String，PicType As String，_
可選ByVal質量為Byte = 80，_
可選ByVal TIFF_ColorDepth As Long = 24，_
可選ByVal TIFF_Compression As Long = 6)
屏幕。MousePointer =沙漏
Dim tSI As GdiplusStartupInput
暗淡的lRes壹樣長
Dim lGDIP As Long
Dim lBitmap As Long
Dim aEncParams()作為字節
出錯時轉到錯誤句柄:
Tsi。gdiplosvision = 1 '初始化GDI+
lRes = GdiplusStartup(lGDIP，tSI)
如果lRes = 0，則從句柄創建GDI+圖像。
lRes = GdipCreateBitmapFromHBITMAP(PICT。句柄，0，lBitmap)
如果lRes = 0，則
Dim tJpgEncoder作為GUID
“Dim tParams As EncoderParameters”初始化解碼器的GUID標識。
選擇大小寫(PicType)
案例“jpg”
CLSIDFromString StrPtr(" { 557 cf 401-1a 04-11 D3-9a 73-0000 f 81ef 32 e } ")，tJpgEncoder
TParams.count = 1 '設置解碼器參數。
帶tParams。參數質量
ClsidFromstring strptr(" { 1 D5 be 4 b 5-fa4a-452d-9cdd-5db 35105 e 7 EB } ")。“guid”獲取質量參數的GUID標識。
。NumberOfValues = 1
。類型= 4
。值= VarPtr(質量)
以…結尾
ReDim aEncParams(1到Len(tParams))
調用CopyMemory(aEncParams(1)，tParams，Len(tParams))
案例“巴布亞新幾內亞”
CLSIDFromString StrPtr(" { 557 cf 406-1a 04-11d 3-9a 73-0000 f 81ef 32e } ")，tJpgEncoder
ReDim aEncParams(1到Len(tParams))
案例“gif”
CLSIDFromString StrPtr(" { 557 cf 402-1a 04-11d 3-9a 73-0000 f 81ef 32e } ")，tJpgEncoder
ReDim aEncParams(1到Len(tParams))
案例“tiff”
CLSIDFromString StrPtr(" { 557 cf 405-1a 04-11d 3-9a 73-0000 f 81ef 32e } ")，tJpgEncoder
tParams.count = 2
ReDim aEncParams(1 To Len(tParams)+Len(tParams。參數))
帶tParams。參數
。NumberOfValues = 1
。類型= 4
ClsidFromstring strptr(" { e09d 739d-CCD 4-44EE-8 EBA-3 fbf 8 be 4 fc 58 } ")。“GUID”獲取ColorDepth參數的GUID標識。
。value = VarPtr(TIFF_Compression)
以…結尾
調用CopyMemory(aEncParams(1)，tParams，Len(tParams))
帶tParams。參數
。NumberOfValues = 1
。類型= 4
ClsidFromstring strptr(" { 66087055-ad66-4c7c-9a 18-38a 2310b 8337 } ")。“GUID”獲取壓縮參數的GUID標識。
。value = VarPtr(TIFF_ColorDepth)
以…結尾
調用copy memory(aEncParams(Len(tParams)+1)，tParams。參數，Len(tParams。參數))
case“bmp”’因為沒有使用GDI+，所以可以提前把保存為BMP的代碼寫出來。
保存圖片pict，文件名
屏幕。鼠標指針= vbDefault
出口接頭
結束選擇
Lres = gdisavimagetofile (lbitmap，strptr(文件名)，tjpegncoder，aencparams (1))'保存圖像。
“GdipDisposeImage lBitmap”銷毀GDI+圖像。
如果…就會結束
GdiplusShutdown lGDIP '銷毀GDI+
如果…就會結束
屏幕。鼠標指針= vbDefault
擦除aEncParams
出口接頭
錯誤句柄:
屏幕。鼠標指針= vbDefault
MsgBox "保存圖片時出錯:" &；vbCrLf & amp；vbCrLf & amp；"錯誤號:" &；呃。數量和數量。vbCrLf & amp；"錯誤描述:" &；呃。描述，_
VbInformation或vbOKOnly，“錯誤”
末端接頭