史萊姆論壇 - VB6.0另存圖檔的功能

史萊姆論壇 (http://forum.slime.com.tw/)

- 程式語言討論區 (http://forum.slime.com.tw/f76.html)

- - VB6.0另存圖檔的功能 (http://forum.slime.com.tw/thread250858.html)

VB6.0另存圖檔的功能

各位先進們好，今天做了一個另存新檔的功能，但打開存好的圖檔卻無法顯示，程式碼如下：

語法:

Private Sub save_Click()

    CommonDialog2.Filter = "JPEG(*.jpg)|*.jpg"

    CommonDialog2.FilterIndex = 2

    CommonDialog2.ShowSave

        If Not CommonDialog2.FileName = "" Then

            Dim fso, MyFile

            Set fso = CreateObject("Scripting.FileSystemObject")

            Set MyFile = fso.CreatePictureFile(CommonDialog2.FileName, True)

            MyFile.WriteLine (Picture1.Picture)

            MyFile.Close

            Set fso = Nothing

            Set MyFile = Nothing

            MsgBox "儲存成功"

        End If

End Sub

我大概知道問題應該出在這行Set MyFile = fso.CreatePictureFile(CommonDialog2.FileName, True)
但不知怎麼改才對，Run程式時出現錯誤訊息，謝謝。

PS:會出現執行階段錯誤'438'物件不支援此屬性或方法，指的就是我上面那行。

Scripting.FileSystemObject
只能賦予 fso基本的檔案系統複製、搬移、刪除...等等能力(就類似 Windows 檔案總管 )

像存圖檔格式這種能力是不包含在內的
其實VB本身就有提供存圖函數
SavePicture Picture1, FileName

想想既然有 LoadPicture 那當然就有存圖函數啦
只是能存的格式不多就是了...

引用:

作者: mini (文章 2178805)

大大，這個指令我用過了，但好像不能存成jpg？謝謝。

引用:

作者: chung1206 (文章 2179000)

大大，這個指令我用過了，但好像不能存成jpg？謝謝。

那你可能要引入外掛DLL嘍～
(用過 PaintX.dll、GflAx.dll，其中 GflAx.dll功能比較強大，但掛上 DLL編譯成軟體移植時就必須帶著走
軟體需打包成安裝檔方式，也就大多了...)

個人以前也找過相關用API來實現
提供一個 ...
運行前請確認系統內(C:\WINDOWS\system32)是否有 GDIPLUS.DLL (這是一個微軟的程式庫，理論上大家都會有才對)

語法:

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



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



    '初始化 GDI+

    tSI.GdiplusVersion = 1

    lRes = GdiplusStartup(lGDIP, tSI)

   

    If lRes = 0 Then

        '從句柄創建 GDI+ 圖像

        lRes = GdipCreateBitmapFromHBITMAP(pict.handle, 0, lBitmap)

   

        If lRes = 0 Then

            Dim tJpgEncoder As GUID

            Dim tParams As EncoderParameters

            

            '初始化解碼器的GUID標識

            CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

      

            '設置解碼器參數

            tParams.Count = 1

         

            With tParams.Parameter ' Quality

                '得到Quality參數的GUID標識

                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID

                .NumberOfValues = 1

                .type = 4

                .Value = VarPtr(quality)

            End With

         

            '保存圖像

            lRes = GdipSaveImageToFile( _

                   lBitmap, _

                   StrPtr(filename), _

                   tJpgEncoder, _

                   tParams)

                             

            '銷毀GDI+圖像

            GdipDisposeImage lBitmap

        End If

      

        '銷毀 GDI+

        GdiplusShutdown lGDIP

    End If

   

    If lRes Then Err.Raise 5, , "不能保存這個圖像：" & lRes

   

End Sub

如何使用
SaveJPG PictureBox1.Image, "c:\1.jpg", 100 '品質從1~100

感謝版主慷慨解囊，您那個太複雜了，我看不太懂，已用其它方式解決了，謝謝您。