《vb小程序vb代码：将图片保存或转变为jpg格式》由会员分享，可在线阅读，更多相关《vb小程序vb代码：将图片保存或转变为jpg格式（6页珍藏版）》请在金锄头文库上搜索。
1、VB小程序 VB代码：将图片保存或转变为JPG格式当前位置： 将图片保存或转变为 JPG 格式12. 将图片保存或转变为JPG格式本人原创，转载请注明出处：http:/ SavePicToFile 把图象保存为 JPG、TIFF、PNG、GIF、BMP 格式。成功返回空字符串，失败返回错误信息。需要在窗体放置控件：Command1，Picture1，Text1 以下代码在 VB6 调试通过。Private Type GUIDData1 As LongData2 As IntegerData3 As IntegerData4(0 To 7) As ByteEnd TypePrivate Type
2、 GdiplusStartupInputGdiplusVersion As LongDebugEventCallback As LongSuppressBackgroundThread As LongSuppressExternalCodecs As LongEnd TypePrivate Type EncoderParameternGUID As GUIDNumberOfValues As LongType As LongValue As LongEnd TypePrivate Type EncoderParameters Count As LongParameter As EncoderP
3、arameterEnd TypeEnum PicTypep_BMPp_JPGp_GIFp_PNGp_TIFFEnd EnumPrivate Declare Function GdiplusStartup Lib (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As LongPrivate Declare Function GdiplusShutdown Lib (ByVal token As Long) As LongPrivate Declare Function G
4、dipCreateBitmapFromHBITMAP Lib (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As LongPrivate Declare Function GdipDisposeImage Lib (ByVal Image As Long) As LongPrivate Declare Function GdipSaveImageToFile Lib (ByVal Image AsLong, ByVal FileName As Long, clsidEncoder As GUID, encoderParams A
5、s Any) As LongPrivate Declare Function CLSIDFromString Lib (ByVal Str As Long, id As GUID) As LongPrivate Declare Function CopyMemory Lib RtlMoveMemory (Dest As Any, Src As Any, ByVal cb As Long) As LongPublic Function SavePicToFile(ByVal nPic As StdPicture, ByVal FileName As String, _Optional ByVal
6、 nType As PicType = p_JPG, Optional ByVal Quality As Byte = 80, _Optional ByVal TIFF_ColorDepth As Long = 24, Optional ByVal TIFF_Compression As Long = 6) As String功能：把图象保存为 BMP、JPG、GIF、PNG、TIFF 格式。成功返回空字符串，失败返回错误信息如果保存的文件名无扩展名，则自动添加相应的扩展名 StdPicture) 图象句柄FileName 保存文件名nType 文件格式： 0 BMP 1 JPG 2 GIF
7、3 PNG 4 TIFFQuality JPG 图象质量TIFF_ColorDepth TTF 格式的颜色深度TIFF_Compression TTF 格式的压缩比Dim dl As Long, nGDIP As Long, nBMP As LongDim nGSI As GdiplusStartupInput, B() As ByteOn Error GoTo CuonGSI.GdiplusVersion = 1 初始化 GDI+dl = GdiplusStartup(nGDIP, nGSI)If dl : Exit Functiondl = GdipCreateBitmapFromHBIT
8、MAP(nPic.Handle, 0, nBMP)If dl 不支持图片格式: Exit FunctionDim mGUID As GUID, mEP As EncoderParameters 初始化解码器的 GUID 标识Select Case nTypeCase p_JPGIf LCase(Right(FileName, 4) Then FileName = FileName & CLSIDFromString StrPtr(557CF401-1A04-11D3-9A73-0000F81EF32E), mGUIDmEP.Count = 1 设置解码器参数With mEP.Parameter
9、CLSIDFromString StrPtr(1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB), .nGUID 得到 GUID 标识.NumberOfValues = 1 .Type = 4.Value = VarPtr(Quality)End WithReDim B(1 To Len(mEP)Call CopyMemory(B(1), mEP, Len(mEP)Case p_GIFIf LCase(Right(FileName, 4) Then FileName = FileName & CLSIDFromString StrPtr(557CF402-1A04-11
10、D3-9A73-0000F81EF32E), mGUIDReDim B(1 To Len(mEP)Case p_PNGIf LCase(Right(FileName, 4) Then FileName = FileName & CLSIDFromString StrPtr(557CF406-1A04-11D3-9A73-0000F81EF32E), mGUIDReDim B(1 To Len(mEP)Case p_TIFFIf LCase(Right(FileName, 5) Then FileName = FileName & CLSIDFromString StrPtr(557CF405-
11、1A04-11D3-9A73-0000F81EF32E), mGUIDmEP.Count = 2ReDim B(1 To Len(mEP) + Len(mEP.Parameter)With mEP.Parameter.NumberOfValues = 1.Type = 4CLSIDFromString StrPtr(E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58), .nGUID.Value = VarPtr(TIFF_Compression) End WithCall CopyMemory(B(1), mEP, Len(mEP)With mEP.Parameter.
12、NumberOfValues = 1.Type = 4CLSIDFromString StrPtr(66087055-AD66-4C7C-9A18-38A2310B8337), .nGUID.Value = VarPtr(TIFF_ColorDepth)End WithCall CopyMemory(B(Len(mEP) + 1), mEP.Parameter, Len(mEP.Parameter)Case Else p_BMP 没有使用 GDI+If LCase(Right(FileName, 4) Then FileName = FileName SavePicture nPic, Fil
13、eNameExit FunctionEnd Selectdl = GdipSaveImageToFile(nBMP, StrPtr(FileName), mGUID, B(1) 保存到文件GdipDisposeImage nBMP 销毁 GDI+ 图像GdiplusShutdown nGDIP 销毁 GDI+Exit FunctionCuo:SavePicToFile = Err.DescriptionEnd FunctionPrivate Sub Form_Load()Me.Caption = Text1.Text = End SubPrivate Sub Command1_Click()
14、Dim nStr As String, F As StringPicture1.AutoSize = True: Command1.ZOrderF = Trim(Text1.Text)Picture1.Picture = LoadPicture(F)默认保存为 JPG 格式，如果无扩展名，则自动添加扩展名。成功返回空字符串F = NoKuo(F) 去掉原扩展名nStr = SavePicToFile(Picture1.Picture, F)If nStr Then MsgBox nStrEnd SubPrivate Function NoKuo(F As String) As StringDim I As LongFor I = Len(F) To 1 Step -1If Mid(F, I, 1) = Then NoKuo = Left(F, I - 1): Exit FunctionNextNoKuo = FEnd Function当前位置： 将图片保存或转变为 JPG 格式查看文档来源：http:/
