文档章节

VB6.0用GDI+保存图像为BMP\JPG\PNG\GIF格式终结版。

abcijkxyz
 abcijkxyz
发布于 2016/11/22 16:38
字数 997
阅读 5
收藏 0

鉴于之前在http://blog.csdn.net/laviewpbt/article/details/756547发布的代码很匆忙,也存在不少错误,现发布比较完美版的解决方案。

 

Option Explicit

Private Const UnitPixel                  As Long = 2
Private Const EncoderQuality             As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"

Private Type GdiplusStartupInput
    GdiplusVersion           As Long
    DebugEventCallback       As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs   As Long
End Type

Private Enum EncoderParameterValueType
    EncoderParameterValueTypeByte = 1
    EncoderParameterValueTypeASCII = 2
    EncoderParameterValueTypeShort = 3
    EncoderParameterValueTypeLong = 4
    EncoderParameterValueTypeRational = 5
    EncoderParameterValueTypeLongRange = 6
    EncoderParameterValueTypeUndefined = 7
    EncoderParameterValueTypeRationalRange = 8
End Enum

Private Type EncoderParameter
    GUID(0 To 3)        As Long
    NumberOfValues      As Long
    Type                As EncoderParameterValueType
    Value               As Long
End Type

Private Type EncoderParameters
    Count               As Long
    Parameter           As EncoderParameter
End Type

Private Type ImageCodecInfo
    ClassID(0 To 3)     As Long
    FormatID(0 To 3)    As Long
    CodecName           As Long
    DllName             As Long
    FormatDescription   As Long
    FilenameExtension   As Long
    MimeType            As Long
    Flags               As Long
    Version             As Long
    SigCount            As Long
    SigSize             As Long
    SigPattern          As Long
    SigMask             As Long
End Type

Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal hImage As Long, ByVal sFilename As Long, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hPal As Long, Bitmap As Long) As Long
Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, Size As Long) As Long
Private Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal Size As Long, Encoders As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszProgID As Long, pCLSID As Any) As Long
Private Declare Function GdipBitmapSetResolution Lib "gdiplus" (ByVal Bitmap As Long, ByVal xdpi As Single, ByVal ydpi As Single) As Long


Public Enum ImageFileFormat
    Bmp = 1
    Jpg = 2
    Png = 3
    Gif = 4
End Enum

Public Function SaveStdPicToFile(Stdpic As StdPicture, ByVal FileName As String, _
                              Optional ByVal FileFormat As ImageFileFormat = Jpg, _
                              Optional ByVal JpgQuality As Long = 80, _
                              Optional Resolution As Single) As Boolean
                              
    Dim CLSID(3)        As Long
    Dim Bitmap          As Long
    Dim Token           As Long
    Dim Gsp             As GdiplusStartupInput

    Gsp.GdiplusVersion = 1                      'GDI+ 1.0版本
    GdiplusStartup Token, Gsp                   '初始化GDI+
    GdipCreateBitmapFromHBITMAP Stdpic.Handle, Stdpic.hPal, Bitmap
    If Bitmap <> 0 Then                          '说明我们成功的将StdPic对象转换为GDI+的Bitmap对象了
        GdipBitmapSetResolution Bitmap, Resolution, Resolution
        Select Case FileFormat
        Case ImageFileFormat.Bmp
            If Not GetEncoderClsID("Image/bmp", CLSID) = -1 Then
                SaveStdPicToFile = (GdipSaveImageToFile(Bitmap, StrPtr(FileName), CLSID(0), ByVal 0) = 0)
            End If
        Case ImageFileFormat.Jpg                    'JPG格式可以设置保存的质量
            Dim aEncParams()        As Byte
            Dim uEncParams          As EncoderParameters
            If GetEncoderClsID("Image/jpeg", CLSID) <> -1 Then
                uEncParams.Count = 1                                        ' 设置自定义的编码参数,这里为1个参数
                If JpgQuality < 0 Then
                    JpgQuality = 0
                ElseIf JpgQuality > 100 Then
                    JpgQuality = 100
                End If
                ReDim aEncParams(1 To Len(uEncParams))
                With uEncParams.Parameter
                    .NumberOfValues = 1
                    .Type = EncoderParameterValueTypeLong                   ' 设置参数值的数据类型为长整型
                    Call CLSIDFromString(StrPtr(EncoderQuality), .GUID(0))  ' 设置参数唯一标志的GUID,这里为编码品质
                    .Value = VarPtr(JpgQuality)                                ' 设置参数的值:品质等级,最高为100,图像文件大小与品质成正比
                End With
                CopyMemory aEncParams(1), uEncParams, Len(uEncParams)
                SaveStdPicToFile = (GdipSaveImageToFile(Bitmap, StrPtr(FileName), CLSID(0), aEncParams(1)) = 0)
            End If
        Case ImageFileFormat.Png
            If Not GetEncoderClsID("Image/png", CLSID) = -1 Then
                SaveStdPicToFile = (GdipSaveImageToFile(Bitmap, StrPtr(FileName), CLSID(0), ByVal 0) = 0)
            End If
        Case ImageFileFormat.Gif
            If Not GetEncoderClsID("Image/gif", CLSID) = -1 Then                '如果原始的图像是24位,则这个函数会调用系统的调色板来将图像转换为8位,转换的效果会不尽人意,但也有可能系统不自动转换,保存失败
                SaveStdPicToFile = (GdipSaveImageToFile(Bitmap, StrPtr(FileName), CLSID(0), ByVal 0) = 0)
            End If
        End Select
    End If
    GdipDisposeImage Bitmap      '注意释放资源
    GdiplusShutdown Token       '关闭GDI+。
End Function


Private Function GetEncoderClsID(strMimeType As String, ClassID() As Long) As Long
    Dim Num         As Long
    Dim Size        As Long
    Dim I           As Long
    Dim Info()      As ImageCodecInfo
    Dim Buffer()    As Byte
    GetEncoderClsID = -1
    GdipGetImageEncodersSize Num, Size               '得到解码器数组的大小
    If Size <> 0 Then
       ReDim Info(1 To Num) As ImageCodecInfo       '给数组动态分配内存
       ReDim Buffer(1 To Size) As Byte
       GdipGetImageEncoders Num, Size, Buffer(1)            '得到数组和字符数据
       CopyMemory Info(1), Buffer(1), (Len(Info(1)) * Num)     '复制类头
       For I = 1 To Num             '循环检测所有解码
           If (StrComp(PtrToStrW(Info(I).MimeType), strMimeType, vbTextCompare) = 0) Then         '必须把指针转换成可用的字符
               CopyMemory ClassID(0), Info(I).ClassID(0), 16  '保存类的ID
               GetEncoderClsID = I      '返回成功的索引值
               Exit For
           End If
       Next
    End If
End Function

Private Function PtrToStrW(ByVal lpsz As Long) As String
    Dim Out         As String
    Dim Length      As Long
    Length = lstrlenW(lpsz)
    If Length > 0 Then
        Out = StrConv(String$(Length, vbNullChar), vbUnicode)
        CopyMemory ByVal Out, ByVal lpsz, Length * 2
        PtrToStrW = StrConv(Out, vbFromUnicode)
    End If
End Function

 

本文转载自:http://www.cnblogs.com/Imageshop/archive/2012/03/02/2377871.html

共有 人打赏支持
abcijkxyz
粉丝 64
博文 6196
码字总数 1876
作品 0
深圳
项目经理
聊一聊几种常用web图片格式:gif、jpg、png、webp

前言 在大多数的web页面中,图片占到了页面大小的60%-70%。因此在web开发中,不同的场景使用合适的图片格式对web页面的性能和体验是很重要的。图片格式种类非常多,本文仅针对几种web应用中常...

antwang
06/27
0
0
使用pngquant工具对PNG格式图片进行压缩

很多网站都对上传图片的大小有限制。如开源中国的博客限制图片大小在200KB以内。但是图片的大小很容易超过200KB,这就需要让我们想办法压缩下图片的空间。 这几天我拍摄了很多花草树木主题的...

北风其凉
2016/07/17
460
0
VC实现多格式图像的转换

色彩鲜艳漂亮的高品质图像,一个个形象生动的Windows图标,高速运动、活灵活现的三维动画,这些无一不显示出程序设计者的艺术才华。在程序设计中,图像处理已经成为每个程序员的必修课。 在V...

余二五
2017/11/06
0
0
开源图形库--CxImage

CxImage是一个可以用于MFC 的C++图像处理类库类,它可以打开,保存,显示,转换各种常见格式的图像文件,比如BMP, JPEG, GIF, PNG, TIFF, MNG, ICO, PCX, TGA, WMF, WBMP, JBG, J2K 等格式的...

匿名
2009/08/21
18.2K
0
图像编辑器--Artweaver

Artweaver是一款模拟自然画笔工具的图像编辑器,如粉笔、木炭、铅笔等。它支持常见的图像格式,如BMP、GIF、PEG、JPEG、 PCX、TGA、TIFF、PNG以及PSD,当然还有其自己的AWD 。它的图像编辑功...

匿名
2009/11/01
1K
0

没有更多内容

加载失败,请刷新页面

加载更多

【大福利】极客时间专栏返现二维码大汇总

我已经购买了如下专栏,大家通过我的二维码你可以获得一定额度的返现! 然后,再给大家来个福利,只要你通过我的二维码购买,并且关注了【飞鱼说编程】公众号,可以加我微信或者私聊我,我再...

飞鱼说编程
今天
1
0
Spring5对比Spring3.2源码之容器的基本实现

最近看了《Spring源码深度解析》,该书是基于Spring3.2版本的,其中关于第二章容器的基本实现部分,目前spring5的实现方式已有较大改变。 Spring3.2的实现: public void testSimpleLoad(){...

Ilike_Java
今天
1
0
【王阳明心学语录】-001

1.“破山中贼易,破心中贼难。” 2.“夫万事万物之理不外于吾心。” 3.“心即理也。”“心外无理,心外无物,心外无事。” 4.“人心之得其正者即道心;道心之失其正者即人心。” 5.“无...

卯金刀GG
今天
2
0
OSChina 周三乱弹 —— 我们无法成为野兽

Osc乱弹歌单(2018)请戳(这里) 【今日歌曲】 @ _刚刚好: 霸王洗发水这波很骚 手机党少年们想听歌,请使劲儿戳(这里) hahahahahahh @嘻酱:居然忘了喝水。 让你喝可乐的话, 你准忘不了...

小小编辑
今天
11
0
vm GC 日志 配置及查看

-XX:+PrintGCDetails 打印 gc 日志 -XX:+PrintTenuringDistribution 监控晋升分布 -XX:+PrintGCTimeStamps 包含时间戳 -XX:+printGCDateStamps 包含时间 -Xloggc:<filename> 可以将数据保存为......

Canaan_
昨天
0
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部