TIFFのビット深さ(ビット)、ページ数をGDI+で表示させるには？ (ID：143389)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

> 度々不快な思いをさせてしまいましたでしょうか。
その点はご心配なく。
私自身も興味がある分野だからこそ、回答しているわけで。
(不快な質問内容だった場合は、回答すらつけずに無視しています)

なお、Excel 2010 や Excel 2013 では、32bit版と64bit版とが存在します。
64bit 版では Declare 宣言が異なりますので、お使いの環境を事前に確認しておいてください。

> APIの処理手順？
Gdiplus.dll の各 API は、戻り値が 0 なら正常、0 以外の場合は
エラー値を意味します。戻り値の意味は下記を参照してみてください。
http://msdn.microsoft.com/en-us/library/windows/desktop/ms534175.aspx

> http://okwave.jp/qa/q6001735.html
さて、「Sub test()」の中を順に見ていきますと：

> udtInput.GdiplusVersion = 1
> If GdiplusStartup(lngToken, udtInput, ByVal 0&) <> 0 Then
これは、GDI+ を呼び出すための決まり文句だと思ってください。
最初に GdiplusStartup を呼び出し、終わったら GdiplusShutdown で終了します。

初期化に成功した場合は、第一引数にて「トークン」というポインタ値を返します。
このトークンは、GdiplusShutdown の時に必要となります。

> If GdipCreateBitmapFromFile(ByVal StrPtr(srcPath), pSrcBmp) <> 0 Then
GdipCreateBitmapFromFile は、「Bitmap オブジェクト」を作る方法の一つです。

第一引数にフルパスを指定すると、第二引数に「Bitmap オブジェクト」のポインタが渡されます。
今回は、この Bitmap オブジェクトから情報を得ていくことになります。

この API に不正なファイルなどを指定するとエラーになるため、出来れば、
  Dim lngErrorCode As Long
  lngErrorCode = GdipCreateBitmapFromFile(ByVal StrPtr(srcPath), pSrcBmp)
  If lngErrorCode <> 0 Then
のように、それぞれの戻り値は変数に受け取っておいた方が良いでしょう。
(たとえばファイルパスが間違っていた場合には、エラー値 10:FileNotFound が返されます)

> GdipGetImageWidth pSrcBmp, lngWidth
> GdipGetImageHeight pSrcBmp, lngHeight
サンプルでは戻り値を受け取っていないようですが、これも正常時には 0 を返す関数です。
それぞれ、第一引数に Bitmap オブジェクトのポインタを渡すと、
第二引数に指定した変数が、それぞれのサイズに書き換わります。

なお、上記 API を使う代わりに、先述した「GdipGetPropertyItem API」を
使って調べる事もできます。今回はその必要は無いでしょうけれどね。

> GdipGetImageHorizontalResolution pSrcBmp, horResln
> GdipGetImageVerticalResolution pSrcBmp, verResln
これも同様ですね。文字通り、水平解像度と垂直解像度を得る関数です。
「GdipGetPropertyItem API」を使って調べることもできます。

> GdipDisposeImage pSrcBmp
これは、作成した Bitmap オブジェクト(あるいは Image オブジェクト)を破棄するための処理です。

この場所に到達する前に、マクロのエラーで強制終了させてしまったり、
停止ボタンで VBA を停止させてしまったりしなう事が無いよう、十分に注意してください。

破棄し忘れると、使用可能なメモリ領域がその分減少してしまいますので(いわゆるメモリリーク)。

> GdiplusShutdown lngToken
最後に、GDI+ のトークンを渡して処理終了です。

=====================

さて次は、本題の「ページ数」と「ビット深さ」です。

=====================
「ページ数」は GdipImageGetFrameCount API で得られます。宣言はこんな感じ。

Private Type UUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 to 7) As Byte
End Type

Private Declare Function CLSIDFromString Lib "ole32" ( _
    ByVal lpszProgID As Long, _
    ByRef pCLSID As UUID) As Long

Private Declare Function GdipImageGetFrameCount Lib "GDIPlus" ( _
    ByVal GpImage As OLE_HANDLE, _
    DimensionID As UUID, _
    ByRef RetCount As Any) As Long

---------------------
GdipImageGetFrameCount の呼び出し方は、こうなります。
なお、{7462DC86-6180-4C7E-8E3F-EE7333A7A483} というのは、TIFF のフレームを表す固定値です。

Dim FrameDimensionPage As UUID
CLSIDFromString StrPtr("{7462DC86-6180-4C7E-8E3F-EE7333A7A483}"), FrameDimensionPage

Dim frameCount As Long
lngErrorCode = GdipImageGetFrameCount(pSrcBmp, FrameDimensionPage, frameCount)
If lngErrorCode = 0 Then
    Debug.Print "ページ数:", frameCount
End If

=====================
そして「ビット深さ」は、GdipGetPropertyItem API で取得します。
宣言はこんな感じです。

Private Declare Function GdipGetPropertyItemSize Lib "GDIPlus" ( _
    ByVal Image As OLE_HANDLE, _
    ByVal propId As Long, _
    ByRef size As Long) As Long

Private Declare Function GdipGetPropertyItem Lib "GDIPlus" ( _
    ByVal Image As OLE_HANDLE, _
    ByVal propId As Long, _
    ByVal propSize As Long, _
    ByRef buffer As Any) As Long

'Private Const PropertyTagImageWidth      As Long = &H100   '符号無し 32bit整数 または 符号無し 16bit整数
'Private Const PropertyTagImageHeight     As Long = &H101   '符号無し 32bit整数 または 符号無し 16bit整数
 Private Const PropertyTagBitsPerSample   As Long = &H102   '符号無し 16bit整数×数
 Private Const PropertyTagSamplesPerPixel As Long = &H115   '符号無し 16bit整数×数
'Private Const PropertyTagXResolution     As Long = &H11A   '符号無し 32bit整数×2(分子と分母)
'Private Const PropertyTagYResolution     As Long = &H11B   '符号無し 32bit整数×2(分子と分母)
'Private Const PropertyTagResolutionUnit  As Long = &H128   '符号無し 16bit整数(インチ→2、センチ→3)

Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
    ByRef pDst As Any, _
    ByRef pSrc As Any, _
    ByVal ByteLen As Long)
---------------------

ポインタ操作が入るので分かりにくいですが、呼び出し方はこんな感じになります。

32bit カラーの TIFF ならば、bitsPerColor は 8, 8, 8, 8／colorPerBits は 4 となり、
 1bit カラーの TIFF ならば、bitsPerColor は 1／colorPerBits は 1 になると思います。
(画像が無いので検証できず…)

Dim lngSize As Long
Dim vnt As Variant
Dim buf() As Byte

Dim bitsPerColor() As Integer
Dim colorPerBits() As Integer

lngErrorCode = GdipGetPropertyItemSize(pSrcBmp, PropertyTagBitsPerSample, lngSize)
If lngErrorCode = 0 And lngSize > 0 Then
    ReDim buf(lngSize - 1)
    lngErrorCode = GdipGetPropertyItem(pSrcBmp, PropertyTagBitsPerSample, lngSize, buf(0))
    If lngErrorCode = 0 Then
        ReDim bitsPerColor((lngSize - 16) \ 2 - 1)
        RtlMoveMemory bitsPerColor(0), ByVal VarPtr(buf(16)), lngSize - 16
        Debug.Print "Number of bits per color component:",
        For Each vnt In bitsPerColor
            Debug.Print vnt;
        Next
        Debug.Print
    End If
End If

lngErrorCode = GdipGetPropertyItemSize(pSrcBmp, PropertyTagSamplesPerPixel, lngSize)
If lngErrorCode = 0 And lngSize > 0 Then
    ReDim buf(lngSize - 1)
    lngErrorCode = GdipGetPropertyItem(pSrcBmp, PropertyTagSamplesPerPixel, lngSize, buf(0))
    If lngErrorCode = 0 Then
        ReDim colorPerBits((lngSize - 16) \ 2 - 1)
        RtlMoveMemory colorPerBits(0), ByVal VarPtr(buf(16)), lngSize - 16
        Debug.Print "Number of color components per pixel:",
        For Each vnt In colorPerBits
            Debug.Print vnt;
        Next
        Debug.Print
    End If
End If

←解決時は質問者本人がここをチェックしてください。

戻る