疑問 - VB6.0另存圖檔的功能

[mini]

作者: chung1206

大大，這個指令我用過了，但好像不能存成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