QA@IT

VB6 → VB.NET2010 コンバート で選択した図形をJPEG画像として保存する方法が分かりません

4045 PV

お世話になります

VB6.0のPGでExcel2003のシートの図形をクリップボードにコピーし、JPEG画像として保存するPGがあります。
ネット上で公開されていたサンプルを元に作られたもので、以下のソースコードになります。

この度、このVB6.0のソースをVB.NET2010とExcel2010で作り変えようとしていますが、元のVB6.0のソースコードに不明点があり.NET2010での実装方法が分かりません(以下の.NETのソース)
具体的にはVB6.0のソースの『' パラメータ設定』と『' フィルタ呼び出し』の箇所でパラメータの値に設定しているのがどういう値なのかが不明なため、.NETでどう実装すれば良いのかが分からないのです。

環境は旧環境がWindowsXP、VB6.0、Excel2003、
新環境がWindows7 64bit、VB.NET2010、Excel2010です
お知恵を貸して頂ければ幸いです。

VB6のソース

'--------------------------------------------------------------------
' 定義セクション
'--------------------------------------------------------------------
Private Type FLTIMAGE
    StructSize As Integer
    Type As Byte
    Reserved1(0 To 8) As Byte
    hImage As Long
    Reserved3(0 To 19) As Byte
End Type

Private Type FLTFILE
    Reserved1 As Integer
    Ext As String * 4
    Reserved2 As Integer
    Path As String * 260
    Reserved3 As Currency
End Type

Private Declare Function GetFilterInfo Lib _
    "C:\Program Files\Common Files\Microsoft Shared\Grphflt\JPEGIM32.FLT" _
        (ByVal Ver As Integer, ByVal Reserved As Long, _
         phMem As Long, ByVal flags As Long) As Long

Private Declare Function ExportGr Lib "JPEGIM32.FLT" _
    (ff As FLTFILE, fi As FLTIMAGE, ByVal hMem As Long) As Long

Private Declare Function OpenClipboard Lib "user32" _
    (ByVal hWndNewOwner As Long) As Long

Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" _
    (ByVal uFormat As Long) As Long

Const CF_ENHMETAFILE = 14
Private Declare Function CopyEnhMetaFile Lib "gdi32" _
    Alias "CopyEnhMetaFileA" _
    (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long

Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
    (ByVal hemf As Long) As Long

Private Declare Function GlobalFree Lib "kernel32" _
    (ByVal hMem As Long) As Long

'--------------------------------------------------------------------
' 関数名 : SaveClipToJpg
' 機能 : 指定図形をJPGファイルとして保存する
' 引数 : img : シェイプオブジェクト[I]
' path :格納先パス(ファイル名も含む)
' 戻り値 : 成否
'--------------------------------------------------------------
Function SaveClipToJpg(img As Shape, Path As String) As Boolean

    Dim tFltImg As FLTIMAGE
    Dim tFltFile As FLTFILE
    Dim hemf As Long
    Dim hMem As Long

    SaveClipToJpg = False
    'クリップボードにコピー
    img.CopyPicture
    'Selection.CopyPicture

    If OpenClipboard(0) Then
        hemf = CopyEnhMetaFile( _
               GetClipboardData(CF_ENHMETAFILE), _
               vbNullString)
        CloseClipboard
    End If
    If hemf = 0 Then Exit Function

    ' パラメータ設定
    tFltFile.Path = Path & vbNullChar
    With tFltImg
        .StructSize = LenB(tFltImg)
        .Type = 1
        .hImage = hemf
    End With

    ' フィルタ呼び出し
    If GetFilterInfo(3, 0, hMem, &H10000) And &H10 Then
        If ExportGr(tFltFile, tFltImg, hMem) = 0 Then
            SaveClipToJpg = True
        End If
    End If

    If hMem Then GlobalFree hMem
    DeleteEnhMetaFile hemf

End Function

VB.NET2010のソース

Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging

Public Class Class1

    Const CF_ENHMETAFILE As Integer = 14

    <DllImport("user32.dll")> _
    Private Shared Function OpenClipboard( _
    ByVal hWndNewOwner As IntPtr) As Boolean
    End Function
    <DllImport("user32.dll")> _
    Private Shared Function IsClipboardFormatAvailable( _
    ByVal wFormat As Integer) As Integer
    End Function
    <DllImport("user32.dll")> _
    Private Shared Function GetClipboardData( _
    ByVal wFormat As Integer) As IntPtr
    End Function
    <DllImport("user32.dll")> _
    Private Shared Function CloseClipboard() As Integer
    End Function

    <DllImport("gdi32.dll")> _
    Private Shared Function DeleteEnhMetaFile(ByVal hemf As IntPtr) As Boolean
    End Function

    ''' <summary>
    ''' クリップボードのメタファイル形式のデータを取得する
    ''' </summary>
    ''' <param name="hWnd">ウィンドウのハンドル</param>
    ''' <returns>取得したデータ</returns>
    Public Shared Function GetEnhMetafileOnClipboard(ByVal hWnd As IntPtr, ByVal savePath As String) As Boolean

        Dim retValue As Boolean = False
        Dim meta As System.Drawing.Imaging.Metafile = Nothing

        If OpenClipboard(hWnd) Then

            Dim hmeta As IntPtr
            Try
                If IsClipboardFormatAvailable(CF_ENHMETAFILE) <> 0 Then
                    hmeta = GetClipboardData(CF_ENHMETAFILE)
                    meta = New System.Drawing.Imaging.Metafile(hmeta, True)

                    Dim jpgEncoder As ImageCodecInfo = Nothing
                    ' JPEG用のエンコーダの取得
                    For Each ici As ImageCodecInfo _
                        In ImageCodecInfo.GetImageEncoders()
                        If ici.FormatID = ImageFormat.Jpeg.Guid Then
                            jpgEncoder = ici
                            Exit For
                        End If
                    Next

                    ' この箇所があいまい
                    Dim encParams As New EncoderParameters(1)
                    Dim quality As Int64 = 20 ' 品質レベル:20
                    Dim encParam As New EncoderParameter(Encoder.Quality, quality)

                    encParams.Param(0) = encParam
                    meta.Save(savePath, jpgEncoder, encParams)
                    ' この箇所があいまい ここまで

                    retValue = True
                End If
            Finally
                CloseClipboard()
                DeleteEnhMetaFile(hmeta)
            End Try
        End If

        Return retValue

    End Function

End Class

回答

fltファイルを利用するのをやめたのには何か理由があるのでしょうか。

ファイルが見つからないだけの場合 x64環境であれば
C:\Program Files (x86)\Common Files\microsoft shared\GRPHFLT\JPEGIM32.FLT
にファイルはあるかもしれません。


品質レベルの値がわからないというのであれば、レジストリに情報があるとのことで、
お使いの環境では

HKCU\Software\Microsoft\Shared Tools\Graphics Filters\Export\JPEG\Options\Quality

で見つけられるかと思います(75みたいですね)。

編集 履歴 (0)
  • flied_onion さん、ありがとうございます!
    >fltファイルを利用するのをやめたのには何か理由があるのでしょうか。
    止めたのではなくてVB.NETでの該当箇所の実装方法が分からずに困っているのです。
    fltファイルをキーワードにもう少し調べてみます。
    -
ウォッチ

この質問への回答やコメントをメールでお知らせします。