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

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

戻る