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

鉴于之前在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

 

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
### 回答1: 《Visual Basic 6.0 GDI 技术教程》是关于使用Visual Basic 6.0编程语言进行图形设备接口(GDI)编程的指南。GDI是一套在Windows操作系统上进行2D图形绘制和图像处理的API接口。这本教程旨在帮助读者了解如何使用Visual Basic 6.0编写图形用户界面,并通过GDI技术实现高质量的图形操作。 该教程从介绍GDI基础知识开始,包括图像,画笔和刷子等基本概念。接下来,教程详细介绍了如何使用Visual Basic 6.0中的GDI函数和方法进行图形操作,比如绘制直线,填充矩形,绘制曲线等。此外,教程还讨论了如何使用GDI+技术进行更高级的图像处理,如旋转,缩放,裁剪等。 除了基本的图形操作,教程还介绍了如何利用GDI技术创建自定义控件和图形用户界面。读者将学习如何使用Visual Basic 6.0的画布功能,实现自定义按钮,滑块和其他可视化控件。 通过这本教程,读者将学会如何通过Visual Basic 6.0 GDI技术创建各种各样的图形应用程序,如图像编辑器,图表生成器等。这将有助于读者提升编程能力,并将GDI技术应用于实际的软件开发项目中。 总之,《Visual Basic 6.0 GDI 技术教程》提供了详细而全面的指导,帮助读者掌握使用Visual Basic 6.0编写图形操作的技巧和方法。无论是初学者还是有经验的开发人员,都可以从这本教程中获益,并将GDI技术应用到自己的项目中。 ### 回答2: Visual Basic 6.0 GDI 技术教程是一种介绍使用Visual Basic 6.0编程语言与GDI(图形设备接口)技术相结合的教程。GDI是一组用于在Windows操作系统中进行图形和图像处理的应用程序接口。 在这个教程中,我们将学习如何使用Visual Basic 6.0来创建图形、图像和界面设计。GDI技术使我们能够使用Visual Basic 6.0中的各种绘图功能,例如画笔、画刷、渐变、线条和文本等来创建各种图形和图像效果。 在Visual Basic 6.0中,我们可以使用GDI技术来进行各种图形操作,例如绘制几何形状、绘制曲线、渲染文字和图像,以及进行图像处理和图像编辑等。 这个教程会介绍Visual Basic 6.0中GDI技术的基本概念和用法。我们将学习如何创建画布、绘制不同类型的图形、使用不同的绘图工具和属性来设计界面,并学习如何进行图像处理和图像编辑。 在教程的每个章节中,我们将提供具体的示例代码和演示,以便读者能够理解和实践所学的知识。通过这些实践,读者将能够熟练地掌握Visual Basic 6.0与GDI技术的结合应用。 总之,Visual Basic 6.0 GDI技术教程将帮助读者了解如何使用Visual Basic 6.0编程语言与GDI技术相结合,并在应用程序中实现各种图形和图像效果。通过学习这个教程,读者将能够提高自己的图形编程能力,并创建出丰富多样的图形界面应用程序。 ### 回答3: Visual Basic 6.0是一种基于事件驱动的编程语言,目前已经逐渐被更先进的语言取代。GDI(图形设备接口)是Microsoft Windows操作系统中的绘图功能,可用于创建和操作图形对象。 在Visual Basic 6.0中使用GDI技术可以实现图形绘制、图像处理和用户界面设计等功能。GDI提供了一系列的绘图函数和对象,开发者可以利用这些功能来设计出各种各样的界面和图形效果。 首先,通过GDI技术,开发者可以使用基本的绘图函数来绘制直线、曲线、矩形、椭圆等基本图形,并且可以设定颜色和线条样式。这些函数可以用于创建各种自定义的图表、图形和按钮。 其次,GDI还提供了对图像的处理功能。开发者可以使用GDI函数来加载、保存和操作图像,如缩放、旋转、裁剪等。这些功能可以用于实现图像编辑、图像处理和图像呈现等需求。 此外,GDI还为用户界面设计提供了一些功能。通过GDI技术,开发者可以自定义界面的控件外观,如按钮的形状、文字的颜色等,从而实现更加个性化的界面设计。 需要指出的是,Visual Basic 6.0和GDI技术已经相对较老,已经被微软官方认定为不再官方支持的技术。如今,更推荐使用更先进的编程语言和图形库来实现类似的功能,如C#、VB.NET和WPF等。这些语言和库提供了更多的功能和更好的性能,有助于开发出更具现代感的应用程序。

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值