Office中国论坛/Access中国论坛

标题: 保存StdPicture到JPG图片文件的函数 [打印本页]

作者: tmtony 时间: 2008-1-5 16:40
标题: 保存StdPicture到JPG图片文件的函数
Private Type Guid
      Data1 As Long
      Data2 As Integer
      Data3 As Integer
      Data4(0 To 7)    As Byte
  End Type

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

  Private Type EncoderParameter
      Guid As Guid
      NumberOfValues As Long
      type As Long
      Value As Long
  End Type

  Private Type EncoderParameters
      Count As Long
      Parameter As EncoderParameter
  End Type

  Private Declare Function GdiplusStartup Lib "gdiplus" ( _
      token As Long, _
      inputbuf As GdiplusStartupInput, _
      Optional ByVal outputbuf As Long = 0) As Long

  Private Declare Function GdiplusShutdown Lib "gdiplus" ( _
      ByVal token 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 GdipDisposeImage Lib "gdiplus" ( _
      ByVal image As Long) As Long

  Private Declare Function GdipSaveImageToFile Lib "gdiplus" ( _
      ByVal image As Long, _
      ByVal FileName As Long, _
      clsidEncoder As Guid, _
      encoderParams As Any) As Long

  Private Declare Function CLSIDFromString Lib "ole32" ( _
      ByVal str As Long, _
      id As Guid) As Long

  ' ----==== SaveJPG ====----

  Public Sub SaveJPG( _
      ByVal pict As StdPicture, _
      ByVal FileName As String, _
      Optional ByVal quality As Byte = 80)
  Dim tSI    As GdiplusStartupInput
  Dim lRes    As Long
  Dim lGDIP    As Long
  Dim lBitmap    As Long

      ' Initialize GDI+
      tSI.GdiPlusVersion = 1
      lRes = GdiplusStartup(lGDIP, tSI)

      If lRes = 0 Then

            ' Create the GDI+ bitmap
            ' from the image handle
            lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)

            If lRes = 0 Then
                  Dim tJpgEncoder    As Guid
                  Dim TParams    As EncoderParameters

                  ' Initialize the encoder GUID
                  CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), _
                                                tJpgEncoder

                  ' Initialize the encoder parameters
                  TParams.Count = 1
                  With TParams.Parameter    ' Quality
                        ' Set the Quality GUID
                        CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB3505E7EB}"), .Guid
                        .NumberOfValues = 1
                        .type = 1
                        .Value = VarPtr(quality)
                  End With

                  ' Save the image
                  lRes = GdipSaveImageToFile( _
                                    lBitmap, _
                                    StrPtr(FileName), _
                                    tJpgEncoder, _
                                    TParams)

                  ' Destroy the bitmap
                  GdipDisposeImage lBitmap

            End If

            ' Shutdown GDI+
            GdiplusShutdown lGDIP

      End If

      If lRes Then
            Err.Raise 5, , "Cannot save the image. GDI+ Error:" & lRes
      End If

  End Sub

作者: andymark 时间: 2008-1-5 17:09
不错 , 收藏先

作者: fan0217 时间: 2008-1-5 17:59
收藏

作者: Victor_Duane 时间: 2008-1-5 22:28
噢,cuxun兄ole automation这个不是自动引用的吗

作者: huangqinyong 时间: 2008-1-5 22:31
收藏了

作者: Grant 时间: 2008-1-5 22:36
用了不少API函数,收藏~

作者: 西部游侠 时间: 2008-1-5 22:52
对这个实在是不懂啊！！！

作者: t小宝 时间: 2008-1-5 23:40
收藏......

作者: goto2008 时间: 2008-1-7 20:56
汗，这个，能弄个例子吗

作者: andymark 时间: 2008-1-19 17:13
导出IMAGE控件图片的需另加loadpicture
SaveJPG LoadPicture(Me.Image0.Picture), "C:\DD.bmp"

作者: andymark 时间: 2008-1-19 20:06
汗，用上面的语句居然导出的是image连接的图片
当连接路径失效时就不能导出
上面的语句应该怎样书写才能出导IMAGE控件里的图像

作者: tmtony 时间: 2008-1-19 21:02

原帖由 andymark 于 2008-1-19 20:06 发表
汗，用上面的语句居然导出的是image连接的图片
当连接路径失效时就不能导出
上面的语句应该怎样书写才能出导IMAGE控件里的图像

不知要保留成什么格式, 根据原来的格式可保留为 ico 或 bmp

作者: andymark 时间: 2008-1-19 21:13
我想把窗体里的IMAGE控件的图像重新保存到硬盘(BMP格式)

作者: WDLRCZT 时间: 2008-1-19 22:14
精品,收藏了,站长辛苦了

作者: tmtony 时间: 2008-1-19 22:32

原帖由 andymark 于 2008-1-19 21:13 发表
我想把窗体里的IMAGE控件的图像重新保存到硬盘(BMP格式)

原来插入到image是Ico格式还是bmp格式

作者: andymark 时间: 2008-1-20 07:34
原来插入的是ＢＭＰ格式

作者: tanhong 时间: 2008-1-20 08:49
站长又奉献好东西,一律收下,道声谢谢!

作者: tmtony 时间: 2008-1-20 09:47
有知有否明白andymark兄的意思,做了个例子
http://www.office-cn.net/vvb/thread-59204-1-1.html

作者: andymark 时间: 2008-1-20 10:45
谢谢站长百忙之中帮忙做了个示例
也许是我表达不清楚，我需要把窗体中的图像控件（image)的图片保存到硬盘
　　SavePicture Me.Image2.Picture, "C:\ TEST.bmp"
　　　SaveJPG Me.Image２.Picture, "C:\TESTD.bmp"　
　上面语句提示类型不对

　SaveJPG LoadPicture(Me.Image0.Picture), "C:\DD.bmp"　
　这样书写运行ＯＫ，但实际结果只是导出图像控件插入连接路径的图片,并不是真正导出
　
　

作者: haemon 时间: 2008-1-20 11:10
学习学习再学习~~~~

作者: tmtony 时间: 2008-1-20 11:44
不好意思,我会错意思了, 原来是导出image 而非imagelist控件中的图片, 我下午再做一下

作者: tmtony 时间: 2008-1-20 15:19
又做了一个,不知合不合适.
http://www.office-cn.net/vvb/thread-59210-1-1.html

作者: andymark 时间: 2008-1-20 15:47
谢谢分享 ! 正是在下所需的

作者: GOODWIN 时间: 2021-10-15 19:00
学习了

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)