Office中國論壇/Access中國論壇

標(biāo)題: 保存StdPicture到JPG圖片文件的函數(shù) [打印本頁]

作者: tmtony 時(shí)間: 2008-1-5 16:40
標(biāo)題: 保存StdPicture到JPG圖片文件的函數(shù)
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 時(shí)間: 2008-1-5 17:09
不錯(cuò) , 收藏先

作者: fan0217 時(shí)間: 2008-1-5 17:59
收藏

作者: Victor_Duane 時(shí)間: 2008-1-5 22:28
噢,cuxun兄ole automation這個(gè)不是自動引用的嗎

作者: huangqinyong 時(shí)間: 2008-1-5 22:31
收藏了

作者: Grant 時(shí)間: 2008-1-5 22:36
用了不少API函數(shù),收藏~

作者: 西部游俠 時(shí)間: 2008-1-5 22:52
對這個(gè)實(shí)在是不懂�。。�！

作者: t小寶 時(shí)間: 2008-1-5 23:40
收藏......

作者: goto2008 時(shí)間: 2008-1-7 20:56
汗，這個(gè)，能弄個(gè)例子嗎

作者: andymark 時(shí)間: 2008-1-19 17:13
導(dǎo)出IMAGE控件圖片的需另加loadpicture
SaveJPG LoadPicture(Me.Image0.Picture), "C:\DD.bmp"

作者: andymark 時(shí)間: 2008-1-19 20:06
汗，用上面的語句居然導(dǎo)出的是image連接的圖片
當(dāng)連接路徑失效時(shí)就不能導(dǎo)出
上面的語句應(yīng)該怎樣書寫才能出導(dǎo)IMAGE控件里的圖像

作者: tmtony 時(shí)間: 2008-1-19 21:02

原帖由 andymark 于 2008-1-19 20:06 發(fā)表
汗，用上面的語句居然導(dǎo)出的是image連接的圖片
當(dāng)連接路徑失效時(shí)就不能導(dǎo)出
上面的語句應(yīng)該怎樣書寫才能出導(dǎo)IMAGE控件里的圖像

不知要保留成什么格式, 根據(jù)原來的格式可保留為 ico 或 bmp

作者: andymark 時(shí)間: 2008-1-19 21:13
我想把窗體里的IMAGE控件的圖像重新保存到硬盤(BMP格式)

作者: WDLRCZT 時(shí)間: 2008-1-19 22:14
精品,收藏了,站長辛苦了

作者: tmtony 時(shí)間: 2008-1-19 22:32

原帖由 andymark 于 2008-1-19 21:13 發(fā)表
我想把窗體里的IMAGE控件的圖像重新保存到硬盤(BMP格式)

原來插入到image是Ico格式還是bmp格式

作者: andymark 時(shí)間: 2008-1-20 07:34
原來插入的是ＢＭＰ格式

作者: tanhong 時(shí)間: 2008-1-20 08:49
站長又奉獻(xiàn)好東西,一律收下,道聲謝謝!

作者: tmtony 時(shí)間: 2008-1-20 09:47
有知有否明白andymark兄的意思,做了個(gè)例子
http://ctxi.cn/vvb/thread-59204-1-1.html

作者: andymark 時(shí)間: 2008-1-20 10:45
謝謝站長百忙之中幫忙做了個(gè)示例
也許是我表達(dá)不清楚，我需要把窗體中的圖像控件（image)的圖片保存到硬盤
　　SavePicture Me.Image2.Picture, "C:\ TEST.bmp"
　　　SaveJPG Me.Image２.Picture, "C:\TESTD.bmp"　
　上面語句提示類型不對

　SaveJPG LoadPicture(Me.Image0.Picture), "C:\DD.bmp"　
　這樣書寫運(yùn)行ＯＫ，但實(shí)際結(jié)果只是導(dǎo)出圖像控件插入連接路徑的圖片,并不是真正導(dǎo)出
　
　

作者: haemon 時(shí)間: 2008-1-20 11:10
學(xué)習(xí)學(xué)習(xí)再學(xué)習(xí)~~~~

作者: tmtony 時(shí)間: 2008-1-20 11:44
不好意思,我會錯(cuò)意思了, 原來是導(dǎo)出image 而非imagelist控件中的圖片, 我下午再做一下

作者: tmtony 時(shí)間: 2008-1-20 15:19
又做了一個(gè),不知合不合適.
http://ctxi.cn/vvb/thread-59210-1-1.html

作者: andymark 時(shí)間: 2008-1-20 15:47
謝謝分享 ! 正是在下所需的

作者: GOODWIN 時(shí)間: 2021-10-15 19:00
學(xué)習(xí)了

歡迎光臨 Office中國論壇/Access中國論壇 (http://ctxi.cn/)