はじめまして。
VBA初心者です。
XPのExcelVBAで複数枚のTIFFファイルに対してサイズや解像度を取得してEXCELにリスト化するマクロを作成したいのですが、GDI+を利用してビット深さ・ページ数を取得する方法が全く分かりません。
どうか、御教授いただけませんでしょうか？
宜しくお願いいたします。
その TIFF は GDI+ で扱える形式でしょうか。
圧縮パラメータが LZW なら扱えそうですが、JPEG 圧縮だと NG らしいので
その場合は、別の手段を検討する必要があるかも知れません。
http://dobon.net/vb/bbs/log3-43/25941.html
> GDI+を利用してビット深さ・ページ数を取得する方法が全く分かりません。
GDI+ で扱える形式であるならば、ページ数については恐らく、
GdipImageGetFrameCount API で得られるかと思います。dimensionID は
{7462dc86-6180-4c7e-8e3f-ee7333a7a483} を試してみてください。
http://www.gizcollabo.jp/vbtomo/boards/vbqanda_spread_13714.html
http://madia.world.coocan.jp/cgi-bin/VBBBS/wwwlng.cgi?print+200709/07090026.txt
ビット深度や解像度は、GdipGetPropertyItem API でしょうか。
http://msdn.microsoft.com/en-us/library/ms534416.aspx
PropertyTagBitsPerSample (&H102) … 16bit整数
PropertyTagSamplesPerPixel (&H115) … 16bit整数
PropertyTagXResolution (&H11A) … 32bit整数×2 (dpi:分子と分母)
PropertyTagYResolution (&H11B) … 32bit整数×2 (dpi:分子と分母)
> どうか、御教授いただけませんでしょうか？
http://www.tt.rim.or.jp/~rudyard/torii009.html
http://blogs.wankuma.com/jeanne/archive/2005/11/24/19566.aspx
魔界の仮面弁士様
お恥ずかしい“質問”失礼いたしました。。。
「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
> お恥ずかしい“質問”失礼いたしました。。。
デバッグ依頼や作成依頼ではなく、“質問”なのですよね? (一応確認)
> 本っ当に申し訳ありませんが、「GdipGetPropertyItem API 」を使用した
> ビット深度や解像度を取得(表示)させる方法を、
> 教えていただけませんでしょうか。
手順は既に回答してあると思いますが、分からなかった箇所はどの部分でしょうか。
そのものズバリでは無いにしろ、GdipGetPropertyItem API を用いた
実際のコードも紹介されているかと思います。
http://madia.world.coocan.jp/cgi-bin/VBBBS/wwwlng.cgi?print+200709/07090026.txt
先の URL のサンプルでいう「Dim Img As Long」や「Private mhGDIPImage As OLE_HANDLE」が
mp5 さんのコードでいう所の「Dim pSrcBmp As Long」に該当します。
サンプル中では、
Const GdiImageDelay = &H5100&
Const GdiLoopCount = &H5101&
といった値を指定していますが、そこを
>> PropertyTagBitsPerSample (&H102) … 16bit整数
>> PropertyTagSamplesPerPixel (&H115) … 16bit整数
>> PropertyTagXResolution (&H11A) … 32bit整数×2 (dpi:分子と分母)
>> PropertyTagYResolution (&H11B) … 32bit整数×2 (dpi:分子と分母)
に置き換えて試してみてください。
# 検証コードを書こうにも、手元にマルチページなTIFFファイルが
# 無いので、やり方の概要説明だけの回答になってしまいますが、
# その点はご容赦を…。
> が、やはり動きませんでした。(当たり前ですよね・・・)
mp5さんが「やはり」「当たり前」と仰っている根拠は分かりませんが、
単純に動かないと一言で片づけず、文法エラーなのか、実行時エラーなのか、
それとも、動きはするけれども期待動作しないという意味なのか、
もう少し詳しく説明していただけると助かります。
(それによって理解度が見えてきて、回答しやすくなるので)
> ネットを探索して
具体的には、どの URL のコードを参考にされたのでしょうか。
参考にされたものがあるのならば、その URL を教えてください。
> ビット深さの取得を行う以下のマクロを作成しました。
「Debug.Print horResln, verResln」というコードがありますが、
これらの変数に値をセットしている個所も無ければ、そもそも
horResln や verResln を変数宣言している個所さえ無いようです。
Option Explicit なのに変数の宣言忘れというのも不自然ですが、もしかして
これは未完成のコードなのでしょうか。それとも、誤動作ながらも
動作するコードの『一部』のみを掲載したものなのでしょうか。
> BitBlt pSrcBmp, BitPer
文法的には、"BitBlt" という名の Sub あるいは Function を呼んでいるようですが、
このコードは、どういった処理を行うことを意図して書かれたものでしょうか?
最初は、先頭にある API 宣言の Function かと思いましたが、
> 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
それにしては、引数の数が一致しませんし、デバイスコンテキスト(hDC)を渡すべき第一引数に、
GDI+ の Bitmap オブジェクト(GpBitmap) を渡しているのが不自然です。
コードを読み進めてみると、「Dim BitBlt As Long」という宣言も見えますが、
それだと文法的に合わない(Sub や Function では無くなってしまう)ですし…。
魔界の仮面弁士様
度々申し訳ありません。
>デバッグ依頼や作成依頼ではなく、“質問”なのですよね? (一応確認)
下記リンク先のコードを丸写しでマクロをいじっておりほぼ内容の理解はできておりません。。。誠に失礼いたしております。。。
質問ではなく“作成依頼”のつもりで書き込ませいただきました。
>具体的には、どの URL のコードを参考にされたのでしょうか。
>参考にされたものがあるのならば、その URL を教えてください。
http://okwave.jp/qa/q6001735.html
↑OKwebでこのコードを見つけ参考にさせていただきました。
他、構文中の宣言や変数など不自然な部位はWebで検索したものを断片的に入れ込んでみたものです。(これらはURLを控えていません・・・)
>mp5さんが「やはり」「当たり前」と仰っている根拠は分かりませんが、
>単純に動かないと一言で片づけず、文法エラーなのか、実行時エラーなのか、
>それとも、動きはするけれども期待動作しないという意味なのか、
>もう少し詳しく説明していただけると助かります。
>(それによって理解度が見えてきて、回答しやすくなるので)
文法エラーで停止しています。やはり構文の成り立ちが良く分かっていない為、有識者の方がみられましたらヘンテコなことになっているんだと思います。。。
Visual Basic6(基礎編) なる参考書を片手にやっておりますが、構文の基礎もまだままならない状態にあり、お恥ずかしいところですが、何卒お付き合い下さい。
お願いいたします。
「開発者『が』質問するのための場」であって、
「開発者『に』仕事を依頼するための場」でないことはご理解ください。
ここのサイト上部の検索ボックスから、それぞれの掲示板の過去ログを
「依頼」というキーワードで検索してみると分かりますが、そうした行為は、
無償有償に関わらず、原則 NG とされています。
> 構文の基礎もまだままならない状態にあり
その段階で API が必要な処理手を出すのは早すぎる気がしますが、
依頼ではなく、学習目的という事であれば協力しますよ。
(VBA からではなく、VB.NET で取得するのであれば簡単なのですが)
> 何卒お付き合い下さい。
コードだけ手に入れば良い、という考えであれば遠慮するところですが、
サンプルの内容を「理解」しようと努力されるつもりがあるのならば、
こちらの時間のある時にでもコードを書いてみます。
ただし先にもお伝えしたように、当方にはマルチページなTIFFファイルが
手元に無いため、コードを書いたとしても、それを検証できない状態にあります。
ビット数や解像度の異なるサンプル画像を、テスト用に幾つか提供できますか?
魔界の仮面弁士様
>「開発者『が』質問するのための場」であって、
>「開発者『に』仕事を依頼するための場」でないことはご理解ください。
重ね重ね、失礼をいたしました。
仰る通りですね。
度々不快な思いをさせてしまいましたでしょうか。
申し訳ありません。
語彙が少なく、誤解を招く文章しか書けない未熟者です。スミマセン。
まずは、先にご連絡いたしましたサンプルコードをしっかりと読み解くところからはじめていきます。
(用途のみわかっていて、内容理解はとんとできておりませんでした。)
http://okwave.jp/qa/q6001735.html
もし、許されるならば、リンク先のサンプルコードがどういった動き(APIの処理手順？)をするのか参考に解説いただければ幸いです。
解説いただけましたら、それを参考に猛勉強させていただきたく。
> 度々不快な思いをさせてしまいましたでしょうか。
その点はご心配なく。
私自身も興味がある分野だからこそ、回答しているわけで。
(不快な質問内容だった場合は、回答すらつけずに無視しています)
なお、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
魔界の仮面弁士様
サンプルの解説、大変ありがとうございます。
こんなにも御丁寧に教えて下さり、感謝しきれません。
只今サンプルの動きを解説を見ながら確認しているところです。
なるほど、これまで引数に直接サイズやら値が入力されていると思っておりましたが、先に戻り値で返されているのですね。無知でした。
>API に不正なファイルなどを指定するとエラーになるため、
エラーに陥った際、戻り値を変数に受け取っていない場合は、マクロが停止してしまうのでしょうか？つまりはBitmapオブジェクトを破棄する"GdipDisposeImage pSrcBmp"の処理以前に止まるとはこのことなのでしょうか？
> サンプルの解説、大変ありがとうございます。
GdipGetPropertyItem の動作は複雑なので、ここでは説明を省いています。
もしも興味があれば、先に紹介した URL の解説を読んでみてください。
(中級者以上向けに書いた文章なので、分かりにくいかも知れませんが…)
http://madia.world.coocan.jp/cgi-bin/VBBBS/wwwlng.cgi?print+200709/07090026.txt
> なるほど、これまで引数に直接サイズやら値が入力されていると思っておりましたが、先に戻り値で返されているのですね。無知でした。
戻り値では無く、引数で値を返しています。
今回の場合、サイズ等が返されるのは ByRef 引数の部分であって、
戻り値で返されるわけではありません。
「戻り値」が返すのは、関数が正常に実行されたかどうかを表す値ですね。
(0 なら正常、0 以外はエラー内容を示すコード値)
GdiplusStartup の最初の引数や GdipGetImageWidth の最後の引数では、
「変数に値をセットしてから API に渡す(入力引数)」という動作ではなく、
「変数を API に渡すと、API がその変数の値を書き換える(出力引数)」
という動作になっています。
>> API に不正なファイルなどを指定するとエラーになるため、
> エラーに陥った際、戻り値を変数に受け取っていない場合は、
> マクロが停止してしまうのでしょうか？
> つまりはBitmapオブジェクトを破棄する"GdipDisposeImage pSrcBmp"の処理以前に止まるとはこのことなのでしょうか？
いいえ、戻り値を得ているかどうかは、その話とは別の問題です。
また、API がエラー値を返した(0以外の値を返した)というだけでは、
VBA のコードが勝手に停止することもありません。
エラー値(0 以外の値)を返した時の振る舞いを決めるのは、
> If GdipCreateBitmapFromFile(ByVal StrPtr(srcPath), pSrcBmp) <> 0 Then
とか、
> lngErrorCode = GdipCreateBitmapFromFile(ByVal StrPtr(srcPath), pSrcBmp)
> If lngErrorCode <> 0 Then
といった場合のコードを指しています。ここまではよろしいでしょうか。
GdipCreateBitmapFromFile が成功して、pSrcBmp にオブジェクト値がセットされたなら、
必ず GdipDisposeImage を呼び出して、pSrcBmp が指すオブジェクトを破棄せねばなりません。
逆に言えば、GdipCreateBitmapFromFile の呼び出しが失敗していた場合は、
そもそも GdipDisposeImage を呼び出す必要が無いとも言えます。
その意味で、GdipCreateBitmapFromFile の成否を確認するために、戻り値は
必ず調べておかなくてはなりません。それに、画像の読み込みに失敗していた場合は、
その後のサイズ取得などの処理を行わないようにしなければなりませんしね。
これは GdiplusStartup も同様です。呼び出しが成功して lngToken に値がセットされた場合には、
必ず GdiplusShutdown に lngToken を渡して呼び出し、終了処理せねばなりません。
その一方で、GdipGetImageWidth 等に関しては、こうした後始末処理を必要としていません。
つまり、サイズの取得に成功しようと失敗しようとメモリリークとはならないため、これらは
戻り値を調べなかったとしても、さほど問題はありません。もっとも、正しいサイズが
得られたかどうかを保証したいなら、念のために戻り値を確認しておいた方が良いのですが。
> これらの処理以前に止まるとはこのことなのでしょうか？
API の動作と言うよりは、VBA 側のコード停止を指しています。
たとえばコードの強制終了ボタン■を押した場合や、あるいは、
実行時エラー等でコードの実行を中断→停止させたような状況です。。
なお、実行時エラーというのは下記のようなエラーのことです。
「型が一致しません」
「0 で除算しました」
「インデックスが有効範囲にありません」
「オーバーフローしました」
「インデックスが有効範囲にありません」