VB实现图片格式转换BMP转JPG.doc

VB实现图片格式转换BMP转JPGOptionExplicit PrivateTypeGUID Data1AsLong Data2AsInteger Data3AsInteger Data4(0To7)AsByte EndType PrivateTypeGdiplusStartupInput GdiplusVersionAsLong DebugEventCallbackAsLong SuppressBackgroundThreadAsLong SuppressExternalCodecsAsLong EndType PrivateTypeEncoderParameter GUIDAsGUID NumberOfValuesAsLong typeAsLong ValueAsLong EndType PrivateTypeEncoderParameters CountAsLong ParameterAsEncoderParameter EndType PrivateDeclareFunctionGdiplusStartupLibGDIPlus(tokenAsLong,inputbufAsGdiplusStartupInput,ByValoutputbufAsLong)AsLong PrivateDeclareFunctionGdiplusShutdownLibGDIPlus(ByValtokenAsLong)AsLong PrivateDeclareFunctionGdipCreateBitmapFromHBITMAPLibGDIPlus(ByValhbmAsLong,ByValhpalAsLong,BitmapAsLong)AsLong PrivateDeclareFunctionGdipDisposeImageLibGDIPlus(ByValImageAsLong)AsLong PrivateDeclareFunctionGdipSaveImageToFileLibGDIPlus(ByValImageAsLong,ByValfilenameAsLong,clsidEncoderAsGUID,encoderParamsAsAny)AsLong PrivateDeclareFunctionCLSIDFromStringLibole32(ByValstrAsLong,idAsGUID)AsLong PrivateDeclareFunctionGdipCreateBitmapFromFileLibGDIPlus(ByValfilenameAsLong,BitmapAsLong)AsLong PrivateSubCommand1_Click() DimretAsBoolean Picture1.Picture=LoadPicture(C:a.bmp)打开要压缩的图片 ret=PictureBoxSaveJPG(Picture1,C:b.jpg)保存压缩后的图片 Ifret=FalseThen MsgBox保存失败 EndIf EndSub PrivateFunctionPictureBoxSaveJPG(ByValpictAsStdPicture,ByValfilenameAsString,OptionalByValqualityAsByte=80)AsBoolean DimtSIAsGdiplusStartupInput DimlResAsLong DimlGDIPAsLong DimlBitmapAsLong 初始化GDI+ tSI.GdiplusVersion=1 lRes=GdiplusStartup(lGDIP,tSI,0) IflRes=0Then 从句柄创建GDI+图像 lRes=GdipCreateBitmapFromHBITMAP(pict.Handle,0,lBitmap) IflRes=0Then DimtJpgEncoderAsGUID DimtParamsAsEncoderParameters 初始化解码器的GUID标识 CLSIDFromStringStrPtr(557CF401-1A04-11D3-9A73-0000F81EF32E),tJpgEncoder 设置解码器参数 tParams.Count=1 WithtParams.ParameterQuality 得到Quality参数的GUID标识 CLSIDFromStringStrPtr(1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB),.GUID .NumberOfValues=1 .type=4 .Value=VarPtr(quality) EndWith 保存图像 lRes=GdipSaveImageToFile(lBitmap,StrPtr(filename),tJpgEncoder,tParams) 销毁GDI+图像 GdipDisposeImagelBitmap EndIf 销毁GDI