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

名前

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

本文 魔界の仮面弁士様 お恥ずかしい“質問”失礼いたしました。。。 「GdipImageGetFrameCount API 」の使い方が未だ分からず右往左往しておりますが、ネットを探索してGDI+を利用したビット深さの取得を行う以下のマクロを作成しました。 が、やはり動きませんでした。(当たり前ですよね・・・) 本っ当に申し訳ありませんが、「GdipGetPropertyItem API 」を使用した ビット深度や解像度を取得(表示)させる方法を、 教えていただけませんでしょうか。 ちなみに、TIFFは圧縮パラメータが LZW です。 宜しくお願いいたします。 --------------- Option Explicit Private Declare Function GdipCreateBitmapFromFile Lib "Gdiplus" (filename As Any, bitmap As Long) As Long Private Declare Function GdipDisposeImage Lib "Gdiplus" (ByVal Image As Long) As Long Private Declare Sub GdiplusShutdown Lib "Gdiplus" (ByVal token As Long) Private Declare Function GdiplusStartup Lib "Gdiplus" (token As Long, pInput As GdiplusStartupInput, pOutput As Any) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long bmBitsPixel As Integer End Type Private Sub main() Dim udtInput As GdiplusStartupInput Dim lngToken As Long, lngStatus As Long Dim pSrcBmp As Long, pDstBmp As Long Dim BitPer As Single Dim srcPath As String Dim hBmp As Long Dim imgGraphics As Long Dim PixelFormat32bppARGB As Long Dim gdicsn As Long Dim FSO As Variant, SHell As Variant, Folder As Variant Dim Songs As Variant, i As Long, Target As String Dim BitBlt As Long srcPath = texBox1 udtInput.GdiplusVersion = 1 If GdiplusStartup(lngToken, udtInput, ByVal 0&) <> 0 Then Exit Sub End If If GdipCreateBitmapFromFile(ByVal StrPtr(srcPath), pSrcBmp) <> 0 Then GdiplusShutdown lngToken Exit Sub End If Debug.Print BitPer BitBlt pSrcBmp, BitPer Debug.Print horResln, verResln GdipDisposeImage pSrcBmp GdiplusShutdown lngToken With Worksheets Cells(2, 1).Value = BitPer End With MsgBox BitPer & "ビット" End Sub Private Sub cmdCheck_Click() Call main End Sub Private Sub cmdGo1_Click() 'Me!texBox1 = Application.GetOpenFilename(FileFilter:="画像ファイル, *.tif", MultiSelect:=True) Me!texBox1 = Application.GetOpenFilename("画像ファイル, *.tif") End Sub