ab.com コミュニティ

いつもお世話になっております。

一般的な画像フォーマットの縦横サイズを取得するにはどうしたらよいのでしょうか？
DLLを用いて取得してみようとしましたが、
原因不明のエラーが出てしまい困っています。

≪やりたいこと≫
・BMPのみならず、jpeg、Gif、png画像の縦横サイズを得たい。
（BMPはLoadImageで読み込める故）

≪アプローチ方法≫
LoadImageのような使い方でBMP、jpeg、Gif、pngを読み込んで
そのビットマップハンドルを返す[loadimgp.dll]というDLLを使い、
その後にGetObject( hBmp, Len(lpBITMAP), lpBITMAP )を用いて、
画像の縦横サイズを得ようとした。
※loadimgp.dllの場所
http://www.vector.co.jp/soft/win95/prog/se375198.html

≪発生した問題≫
DLLの呼び出し自体は成功するが、それを行った関数を抜けようとすると
アクセス違反と言われる。
グローバルから数えて、２階層以上の関数でエラーが起こる。
（グローバル、１階層めの関数ではエラーしない･･･と言って伝わるでしょうか？＾＾；）

ソースはこちら [ここをクリックすると内容が表示されます]

コード: 全て選択

#N88BASIC

Declare Function LoadImagePlus Lib "loadimgp.dll" Alias "LoadImagePlus" ( pImgFilePath As BytePtr ) As DWord

Dim r As DWord
r = Main()
End

Function Main() As Long
	Dim s As String
	Dim hBmp As DWord
	Dim r As DWord

	s = "picture.jpg"
	hBmp = LoadImagePlus( StrPtr(s) )
	'↑関数化せずに直に書くとエラーはしない。
	'↓しかし、関数にするとエラーする。
	r = GetImgSquareSize( StrPtr(s) ) 
	Print r
	Input s
	DeleteObject( hBmp )
	Main = r
EndFunction

Function GetImgSquareSize( pImgPath As BytePtr ) As DWord
	Dim nWH As DWord
	Dim hBmp As DWord
	Dim lpBITMAP As BITMAP

	Dim pBuf As BytePtr
	pBuf = calloc( 256 )
	ZeroMemory( pBuf, 256 )
	lstrcpy( pBuf, pImgPath )
	'↑pImgPathを直にLoadImagePlus()に渡すと、エラーする。
	'  こうするとエラーしない。原因は不明。
	hBmp = LoadImagePlus( pBuf )

	DeleteObject( hBmp )

	free( pBuf )
EndFunction 'Debugで追っていくと、ここでアクセス違反になる。

開発環境はWin2000 + AB-Ver.3.13です。
Ver4.10.02で試したところ、アクセス違反は起きなくなりましたが、
コードの動作がおかしくなりました。
（関数の途中で勝手に抜けたり、値が代入されなかったり。）
そちらの方は、どういうエラーが起きているのか理解できていません。

≪聞きたいこと≫
上記の方法でなくても、Gif、Jpeg、pngの縦横サイズが
読み取れるのであれば構いません。
直にフォーマットのヘッダ？を読み取ることも考えて
Googleで調べたのですが、仕様は見つけられませんでした･･･。

宜しくご教授お願い致します。

それをダウンロードしてサンプルを見てみましたが，CDECL関数のようです。

こうしたらどうでしょうか。
Declare Function LoadImagePlus CDECL Lib "loadimgp.dll" (pImgFilePath As BytePtr) As DWord

イグトランス様、素早い回答をありがとうございます。
たしかに「CDECL」を指定したところ、アクセス違反は起きなくなりました。
しかし、GetImgSquareSize()内に記述を追加して、
別途ソースにて呼び出したところ、
hBmp = LoadImagePlus( pBuf )
のラインのところから突如として関数を抜ける、というような
ことが起こってしまいました（Debugはその瞬間に無効にされました）。

何が起きているのか今ひとつ分かりません。
ちょっと今夜から数日、バグ解析の時間が取れませんので、
また後日に何が起きているか分かったところで、また質問させていただこうと思います。
その際は、またよろしくお願いいたします。

> イグトランス様、素早い回答をありがとうございます。
> たしかに「CDECL」を指定したところ、アクセス違反は起きなくなりました。
> しかし、GetImgSquareSize()内に記述を追加して、
> 別途ソースにて呼び出したところ、
> hBmp = LoadImagePlus( pBuf )
> のラインのところから突如として関数を抜ける、というような
> ことが起こってしまいました（Debugはその瞬間に無効にされました）。

試しでサンプルを作ってみました。
AB Ver.4.21.00で試したらうまく動作しました。
うまく動かないようであれば以下のソースを単独で実行してみて下さい。
(空のabpファイルにソースをコピペしてF2)

[ここをクリックすると内容が表示されます]

コード: 全て選択

Declare Function LoadImagePlus Lib "loadimgp.dll" (pImgFilePath As BytePtr) As DWord

Function GetImgSquareSize(pImgPath As BytePtr,ByRef xy As POINTAPI) As DWord
	Dim nWH As DWord
	Dim hBmp As DWord
	Dim lpBitmap As BITMAP

	hBmp = LoadImagePlus(pImgPath)
	GetObject(hBmp,Len(lpBitmap),lpBitmap)
	xy.x=lpBitmap.bmWidth
	xy.y=lpBitmap.bmHeight
	DeleteObject( hBmp )
EndFunction

Dim ofn As OPENFILENAME
Dim buf[MAX_PATH-1] As Byte
Dim xy As POINTAPI

ZeroMemory(VarPtr(ofn),Len(ofn))
ZeroMemory(VarPtr(buf),MAX_PATH)
ofn.lStructSize=Len(ofn)
ofn.lpstrFile=buf
ofn.nMaxFile=MAX_PATH
ofn.lpstrFilter=Ex"bmp\0*.bmp\0gif\0*.gif\0jpg\0*.jpg\0png\0*.png\0\0"
If GetOpenFileName(ofn) Then
	GetImgSquareSize(buf,xy)
	MsgBox 0,"X="+Str$(xy.x)+" Y="+Str$(xy.y)
End If

以前に私も似たようなのを作っていたことを思い出しまして。
http://dbp.cool.ne.jp/patio/patio.cgi?mode=view&no=248

[ここをクリックすると内容が表示されます]

コード: 全て選択

#N88BASIC

'{7BF80980-BF32-101A-8BBB-00AA00300CAB}
Class IPicture
	Inherits IUnknown
Public
	Virtual Function get_Handle(pHandle As *HANDLE) As DWord
	Virtual Function get_hPal(phPal As *HANDLE) As DWord		
	Virtual Function get_Type(pType As WordPtr) As DWord
	Virtual Function get_Width(pWidth As DWordPtr) As DWord
	Virtual Function get_Height(pHeight As DWordPtr) As DWord
	Virtual Function Render(hDC As HDC,x As Long,y As Long,cx As Long,cy As Long,xSrc As Long,ySrc As Long,cxSrc As Long,cySrc As Long,pRcWBounds As *RECT) As DWord
	Virtual Function set_hPal(hPal As HANDLE) As DWord   
	Virtual Function get_CurDC(phDC As *HDC) As DWord
	Virtual Function SelectPicture(hDCIn As HDC,phDCOut As *HDC,phBmpOut As *HANDLE) As DWord
	Virtual Function get_KeepOriginalFormat(pKeep As DWordPtr) As DWord
	Virtual Function put_KeepOriginalFormat(keep As DWord) As DWord
	Virtual Function PictureChanged() As DWord
	Virtual Function SaveAsFile(pStream As LPSTREAM,fSaveMemCopy As DWord,pCbSize As DWordPtr) As DWord
	Virtual Function get_Attributes(pDwAttr As DWordPtr) As DWord		
End Class	
Dim IID_IPicture=[&H7BF80980,&HBF32,&H101A,[&H8B,&HBB,&H00,&HAA,&H00,&H30,&H0C,&HAB]] As GUID
TypeDef LPPICTURE=*IPicture

Declare Function CreateStreamOnHGlobal Lib "ole32" (hGlobal As HGLOBAL,fDeleteOnRelease As DWord,ppstm As VoidPtr) As DWord
Declare Function OleLoadPicture Lib "olepro32" (pStream As LPSTREAM,lSize As Long,fRunmode As DWord,riid As *GUID,ppvObj As VoidPtr) As DWord
Declare Sub AtlHiMetricToPixel Lib "atl" (lpSizeInHiMetric As *SIZE,lpSizeInPix As *SIZE)

Dim lpStream As LPSTREAM
Dim lpPicture As LPPICTURE
Dim hGlobal As HGLOBAL,pGlobal As VoidPtr
Dim hFile As HANDLE
Dim dwSize As DWord,dwDummy As DWord
Dim iWidth As Long,iHeight As Long
Dim udtHiMetric As SIZE,udtPixel As SIZE

	hFile=CreateFile("test.jpg",GENERIC_READ,0,ByVal NULL,OPEN_EXISTING,0,0)
	If hFile<>INVALID_HANDLE_VALUE Then
		dwSize=GetFileSize(hFile,NULL)
		hGlobal=GlobalAlloc(GPTR,dwSize)
		pGlobal=GlobalLock(hGlobal)
		ReadFile(hFile,pGlobal,dwSize,VarPtr(dwDummy),ByVal NULL)
		GlobalUnlock(hGlobal)
		CloseHandle(hFile)
		CreateStreamOnHGlobal(hGlobal,TRUE,VarPtr(lpStream))
		OleLoadPicture(lpStream,dwSize,TRUE,VarPtr(IID_IPicture),VarPtr(lpPicture))
		lpStream->Release()
		If lpPicture Then
			lpPicture->get_Width(VarPtr(iWidth))
			lpPicture->get_Height(VarPtr(iHeight))
			With udtHiMetric
				.cx=iWidth
				.cy=iHeight
			End With
			AtlHiMetricToPixel(VarPtr(udtHiMetric),VarPtr(udtPixel))
			lpPicture->Release()
		End If
	End If
	Print udtPixel.cx;"x";udtPixel.cy

相違点は、GDI+を使わないということです。
ということで、PNGは使えないという問題がありますが、とりあえずコードを提示しておきます。
ビットマップハンドルが必要な場合は、lpPicture->get_Handleを使って下さい。
※PNGの場合はサイズだけならバイナリを直接読み込めば取れますが…邪道ですかね？(^^; ハンドルは取れませんが(爆

＞ノッチ様
ありがとうございます。
もうしばらくの間、プログラミングをする時間が取れませんが、
後で試してみます。

＞hira様
そのコードは知ってましたが、COMインターフェイスを使っていらっしゃるようなので
手を出さないでいました（今のところ主力開発はVer.3.xですし＾＾；）。
そうですね。この機会に手を出してみようと思います。
GDI+を使わなくて済むのであれば、それに越したことはありません。
上記の理由で、テスト実行はしばらく後になってしまいますが、
もしよろしければ、PNG縦横サイズのバイナリからの直接読み取り方法も
ご教授いただけないでしょうか？
バイナリから直読み込みはむしろ望むところなのですが、
フォーマットが分からないのです。
（一つずつ読み出して調べれば良いじゃないか、と言われるとその通りなのですが／苦笑）

いちいちPNGのヘッダを全部読もうとすると面倒なので、画像サイズの部分だけ読むようにしてみました。

コード: 全て選択

#prompt
Const BigEndianToLittleEndian(Num)=(((Num) And &HFF)<<24 Or ((Num) And &HFF00)<<8 Or ((Num) And &HFF0000)>>8 Or ((Num) And &HFF000000)>>24)

Dim hFile As HANDLE,dwWidth As DWord,dwHeight As DWord,dwReadSize As DWord
hFile=CreateFile("test.png",GENERIC_READ,FILE_SHARE_READ,ByVal NULL,OPEN_EXISTING,0,0)
SetFilePointer(hFile,16,NULL,FILE_BEGIN)
ReadFile(hFile,VarPtr(dwWidth),4,VarPtr(dwReadSize),ByVal NULL)
ReadFile(hFile,VarPtr(dwHeight),4,VarPtr(dwReadSize),ByVal NULL)
CloseHandle(hFile)
dwWidth=BigEndianToLittleEndian(dwWidth)
dwHeight=BigEndianToLittleEndian(dwHeight)
Print dwWidth;"x";dwHeight

ちなみに、(拡張子だけではなく)ファイルの内容からPNGかどうかを判断するには、最初の8バイトが
89 50 4E 47 0D 0A 1A 0A
であるかをチェックすればいいでしょう。

レスが大変遅れてしまい申し訳ありません。
やっとデバグする時間が取れました。

≫ノッチ様
動作確認ありがとうございます。
当方でも、１階層目の関数呼び出しでは正常動作しました。
しかし、関数から関数を呼び出し･･･というように２階層以上の
関数呼び出しにおいて、エラーにこそならないものの、
値が代入されなかったり、関数の途中で勝手に抜けたりと、
やはりコードの動作がおかしいようです。
（Ver.3.13, Ver.4.10.02, Ver.4.23.00 にて確認。）

もっとも、DLLを使わずに済むのであればそちらのほうが都合よいので、
hira様のコードで対処しようかと思っています。

≫hira様
PNGヘッダからの画像サイズの読み取りコードも示していただき、
ありがとうございます。
それを踏まえて、画像（Bmp,Gif,Jpeg,Png）の縦横サイズ読み取り＆
ビットマップハンドル（Pngを除く）取得をクラスにまとめてみたのですが、
get_Handle() が失敗するようです（返り値がFALSE）。
IPictureインターフェースに関してはさっぱり分からないので、
お手上げ状態なのですが、こちらエラーの原因などわかりますでしょうか？

クラスReadPics定義はこちらをクリック。 [ここをクリックすると内容が表示されます]

コード: 全て選択

Declare Function CreateStreamOnHGlobal Lib "ole32" (hGlobal As HGLOBAL,fDeleteOnRelease As DWord,ppstm As VoidPtr) As DWord
Declare Function OleLoadPicture Lib "olepro32" (pStream As LPSTREAM,lSize As Long,fRunmode As DWord,riid As *GUID,ppvObj As VoidPtr) As DWord
Declare Sub AtlHiMetricToPixel Lib "atl" (lpSizeInHiMetric As *SIZE,lpSizeInPix As *SIZE)


'{7BF80980-BF32-101A-8BBB-00AA00300CAB}
Class IPicture
    Inherits IUnknown
Public
    Virtual Function get_Handle(pHandle As *HANDLE) As DWord
    Virtual Function get_hPal(phPal As *HANDLE) As DWord        
    Virtual Function get_Type(pType As WordPtr) As DWord
    Virtual Function get_Width(pWidth As DWordPtr) As DWord
    Virtual Function get_Height(pHeight As DWordPtr) As DWord
    Virtual Function Render(hDC As HDC,x As Long,y As Long,cx As Long,cy As Long,xSrc As Long,ySrc As Long,cxSrc As Long,cySrc As Long,pRcWBounds As *RECT) As DWord
    Virtual Function set_hPal(hPal As HANDLE) As DWord   
    Virtual Function get_CurDC(phDC As *HDC) As DWord
    Virtual Function SelectPicture(hDCIn As HDC,phDCOut As *HDC,phBmpOut As *HANDLE) As DWord
    Virtual Function get_KeepOriginalFormat(pKeep As DWordPtr) As DWord
    Virtual Function put_KeepOriginalFormat(keep As DWord) As DWord
    Virtual Function PictureChanged() As DWord
    Virtual Function SaveAsFile(pStream As LPSTREAM,fSaveMemCopy As DWord,pCbSize As DWordPtr) As DWord
    Virtual Function get_Attributes(pDwAttr As DWordPtr) As DWord        
End Class    
TypeDef LPPICTURE=*IPicture
Const PICTYPE_UNINITIALIZED = -1
Const PICTYPE_NONE          =  0
Const PICTYPE_BITMAP        =  1
Const PICTYPE_METAFILE      =  2
Const PICTYPE_ICON          =  3




'Pngの縦横サイズを読むための演算マクロ（たぶん）。
Const BigEndianToLittleEndian(Num)=(((Num) And &HFF)<<24 Or ((Num) And &HFF00)<<8 Or ((Num) And &HFF0000)>>8 Or ((Num) And &HFF000000)>>24)



'Jpeg,Gif(,Bmp)のビットマップハンドル読み込みと縦横サイズ取得
'  ＋Pngの縦横サイズ取得を行うクラス。
Class ReadPics
	udtPicPixel As SIZE
	hPicRP As HBITMAP

	'ファイル内容がPngかどうかを返す
	Function IsPng( hFile As HANDLE ) As Long
		Dim pAnyBuf[8] As Byte
		Dim dwReadSize As Dword
		ReadFile( hFile, pAnyBuf, 8, VarPtr(dwReadSize), ByVal NULL )
		If( (pAnyBuf[0]=&H89) _
			And(pAnyBuf[1]=&H50) _
			And(pAnyBuf[2]=&H4E) _
			And(pAnyBuf[3]=&H47) _
			And(pAnyBuf[4]=&H0D) _
			And(pAnyBuf[5]=&H0A) _
			And(pAnyBuf[6]=&H1A) _
			And(pAnyBuf[7]=&H0A) )Then
			IsPng = TRUE
		Else
			IsPng = FALSE
		EndIf
	EndFunction

	'Pngファイルの縦横サイズを読み取る
	Function GetPngSizeWH( hFile As HANDLE ) As Long
		Dim dwWidth As DWord
		Dim dwHeight As DWord
		DIm dwReadSize As DWord

		SetFilePointer( hFile, 16, NULL, FILE_BEGIN )
		ReadFile( hFile, VarPtr(dwWidth), 4, VarPtr(dwReadSize), ByVal NULL )
		ReadFile( hFile, VarPtr(dwHeight), 4,VarPtr(dwReadSize), ByVal NULL )
		dwWidth = BigEndianToLittleEndian( dwWidth )
		dwHeight = BigEndianToLittleEndian( dwHeight )
		udtPicPixel.cx = dwWidth
		udtPicPixel.cy = dwHeight
	EndFunction


Public
	Sub ReadPics()
		hPicRP = NULL
	EndSub
	Sub ~ReadPics()
		If( hPicRP<>NULL )Then
			DeleteObject( hPicRP )
		EndIf
	EndSub

	'指定された画像ファイルの縦横サイズとビットマップハンドル（Png以外）を得る。
	Function CreatePic( pPicPath As BytePtr ) As Long
		Dim hFile As HANDLE
		Dim hGlobal As HGLOBAL
		Dim pGlobal As VoidPtr
		Dim dwSize As DWord
		Dim dwReadSize As DWord
		Dim IID_IPicture=[&H7BF80980,&HBF32,&H101A,[&H8B,&HBB,&H00,&HAA,&H00,&H30,&H0C,&HAB]] As GUID
		Dim lpStream As LPSTREAM
		Dim lpPicture As LPPICTURE
		Dim iWidth As Long,iHeight As Long
		Dim udtHiMetric As SIZE
		Dim hOle=NULL As HANDLE
		Dim wType As Word

		'ファイルオープン
		hFile = CreateFile( pPicPath, GENERIC_READ, NULL, ByVal NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL )
		If( hFile=INVALID_HANDLE_VALUE )Then
			CreatePic = FALSE
			ExitFunction
		EndIf
		If( IsPng( hFile )=TRUE )Then
			'Pngファイルは別途処理
			CreatePic = GetPngSizeWH( hFile )
			CloseHandle( hFile )
			If( hPicRP<>NULL )Then
				DeleteObject( hPicRP )
			EndIf
			hPicRP = NULL
			ExitFunction
		EndIf
		dwSize = GetFileSize( hFile, NULL )
		hGlobal = GlobalAlloc( GPTR, dwSize )
		pGlobal = GlobalLock( hGlobal )
		ReadFile( hFile, pGlobal, dwSize, VarPtr(dwReadSize), ByVal NULL )
		GlobalUnlock( hGlobal )
		CloseHandle( hFile )

		/* オーパーツ扱い（笑）
			OleLoadPicture()＋IStrem＆IPictureインターフェースを利用して
			Jpeg,Gif,Bmpを読み込む。
			OLE (Object Linking and Embedding)を利用しているみたい。
			クリップボードのヤツ？
			上記IPictureクラスにて定義？ */
		CreateStreamOnHGlobal( hGlobal, TRUE, VarPtr(lpStream) )
		OleLoadPicture( lpStream, dwSize, TRUE, VarPtr(IID_IPicture), VarPtr(lpPicture) )
		lpStream->Release()

		'縦横サイズとビットマップハンドルを得る。
		If( lpPicture )Then
			lpPicture->get_Type( VarPtr(wType) )
			If( wType<>PICTYPE_BITMAP )Then
				'絵でないものは弾く
				CreatePic = FALSE
			Else
				CreatePic = TRUE
				'縦横サイズ
				lpPicture->get_Width( VarPtr(iWidth) )
				lpPicture->get_Height( VarPtr(iHeight) )
				With udtHiMetric
					.cx = iWidth
					.cy = iHeight
				End With
				AtlHiMetricToPixel( VarPtr(udtHiMetric), VarPtr(udtPicPixel) )
				'ビットマップハンドル
Dim r As Long 'デバグ用
debug
				r = lpPicture->get_Handle( VarPtr(hOle) )
				If( hPicRP<>NULL )Then
					DeleteObject( hPicRP )
				EndIf
				hPicRP = hOle As HBITMAP
				'開放処理
				lpPicture->Release()
			EndIf
		Else
			CreatePic = FALSE
		EndIf
	EndFunction

	'横サイズを返す
	Function GetWidth() As Long
		GetWidth = udtPicPixel.cx
	End Function
	'縦サイズを返す
	Function GetHeight() As Long
		GetHeight = udtPicPixel.cy
	End Function

	'ビットマップハンドルを返す。
	Function GetBmpHandle() As HBITMAP
		GetBmpHandle = hPicRP
	End Function

End Class

上記クラスの動作テストが下記

コード: 全て選択

#N88BASIC


Dim lp As ReadPics

Dim s As String
Dim hPic As HBITMAP

s = "test.jpg"

lp.CreatePic( StrPtr(s) )

Print lp.GetHeight()
Print lp.GetWidth()
hPic = lp.GetBmpHandle()
Debug '←hPicが「利用できない」になっている。

Input s
End

Ver.4.23.00にて確認。
よろしくお願いいたします。

IsPNG関数を呼び出しているために、ファイルポインタが8バイト分進んでしまっているようです。
IsPNG関数を呼び出した後、ReadFile関数を呼び出すまでのどこかに

コード: 全て選択

SetFilePointer( hFile, 0, NULL, FILE_BEGIN )

の1行を加えればOKです。
※IsPNG関数の最後にこの処理を追加してもいいでしょう

> ファイルポインタが8バイト分進んでしまっているようです。
うっかりしてました。

修正版のIsPng関数 [ここをクリックすると内容が表示されます]

コード: 全て選択

	'ファイル内容がPngかどうかを返す（※ファイルポインタはトップを仮定）
	Function IsPng( hFile As HANDLE ) As Long
		Dim pAnyBuf[8] As Byte
		Dim dwReadSize As Dword
		SetFilePointer( hFile, 0, NULL, FILE_BEGIN )
			ReadFile( hFile, pAnyBuf, 8, VarPtr(dwReadSize), ByVal NULL )
		SetFilePointer( hFile, 0, NULL, FILE_BEGIN )
		If( (pAnyBuf[0]=&H89) _
			And(pAnyBuf[1]=&H50) _
			And(pAnyBuf[2]=&H4E) _
			And(pAnyBuf[3]=&H47) _
			And(pAnyBuf[4]=&H0D) _
			And(pAnyBuf[5]=&H0A) _
			And(pAnyBuf[6]=&H1A) _
			And(pAnyBuf[7]=&H0A) )Then
			IsPng = TRUE
		Else
			IsPng = FALSE
		EndIf
	EndFunction

get_Handle() が失敗する問題は、IsPng()を付け加える前から発生しており、
修正版に変更してみましたが、はやりハンドル取得に失敗するようです。
なお、get_Width(), get_Height() は成功しています。

検索してみたところ、get_Handle()で得たハンドルをBITMAP型にキャストする
流れは合っているようなのですが･･･
それとも、IPictureで得た画像はビットマップハンドルを通さずに、
Render()を用いて描画する必要があるのでしょうか？

get_Handle()の戻り値は、成功するとS_OK(0)です。
hOleにハンドルが取れていないなら話は別ですが、ハンドルが取れていて、戻り値が0であるなら正常な動作と考えていいでしょう。

> get_Handle()の戻り値は、成功するとS_OK(0)です。
そうだったのですか。
FALSE(0)と早とちりしてました。
なお、描画失敗の原因は、描画の前にRelease()メンバを実行してしてしまっていたことでした。
ハンドルは取れていました（＝アドレスがNULLじゃないということですよね？）が、
Debugで「->unused 利用できません」と出たのを見て、FALSE(0)とあわせて
「get_Handle()が失敗していることが原因」と思い込んでしました。

解決しました。
hira様、素早い返信をありがとうございました。

以下、まとめ。

修正版のクラス定義です。 [ここをクリックすると内容が表示されます]

コード: 全て選択

Declare Function CreateStreamOnHGlobal Lib "ole32" (hGlobal As HGLOBAL,fDeleteOnRelease As DWord,ppstm As VoidPtr) As DWord
Declare Function OleLoadPicture Lib "olepro32" (pStream As LPSTREAM,lSize As Long,fRunmode As DWord,riid As *GUID,ppvObj As VoidPtr) As DWord
Declare Sub AtlHiMetricToPixel Lib "atl" (lpSizeInHiMetric As *SIZE,lpSizeInPix As *SIZE)


'{7BF80980-BF32-101A-8BBB-00AA00300CAB}
Class IPicture
    Inherits IUnknown
Public
    Virtual Function get_Handle(pHandle As *HANDLE) As DWord
    Virtual Function get_hPal(phPal As *HANDLE) As DWord        
    Virtual Function get_Type(pType As WordPtr) As DWord
    Virtual Function get_Width(pWidth As DWordPtr) As DWord
    Virtual Function get_Height(pHeight As DWordPtr) As DWord
    Virtual Function Render(hDC As HDC,x As Long,y As Long,cx As Long,cy As Long,xSrc As Long,ySrc As Long,cxSrc As Long,cySrc As Long,pRcWBounds As *RECT) As DWord
    Virtual Function set_hPal(hPal As HANDLE) As DWord   
    Virtual Function get_CurDC(phDC As *HDC) As DWord
    Virtual Function SelectPicture(hDCIn As HDC,phDCOut As *HDC,phBmpOut As *HANDLE) As DWord
    Virtual Function get_KeepOriginalFormat(pKeep As DWordPtr) As DWord
    Virtual Function put_KeepOriginalFormat(keep As DWord) As DWord
    Virtual Function PictureChanged() As DWord
    Virtual Function SaveAsFile(pStream As LPSTREAM,fSaveMemCopy As DWord,pCbSize As DWordPtr) As DWord
    Virtual Function get_Attributes(pDwAttr As DWordPtr) As DWord        
End Class    
TypeDef LPPICTURE = *IPicture
Const PICTYPE_UNINITIALIZED = -1
Const PICTYPE_NONE          =  0
Const PICTYPE_BITMAP        =  1
Const PICTYPE_METAFILE      =  2
Const PICTYPE_ICON          =  3




'Pngの縦横サイズを読むための演算マクロ（たぶん）。
Const BigEndianToLittleEndian(Num)=(((Num) And &HFF)<<24 Or ((Num) And &HFF00)<<8 Or ((Num) And &HFF0000)>>8 Or ((Num) And &HFF000000)>>24)



'Jpeg,Gif(,Bmp)のビットマップハンドル読み込みと縦横サイズ取得
'  ＋Pngの縦横サイズ取得を行うクラス。
Class ReadPics
	udtPicPixel As SIZE
	hPicRP As HBITMAP
	lpPicture As LPPICTURE

	'ファイル内容がPngかどうかを返す（※ファイルポインタはトップを仮定）
	Function IsPng( hFile As HANDLE ) As Long
		Dim pAnyBuf[8] As Byte
		Dim dwReadSize As Dword
		SetFilePointer( hFile, 0, NULL, FILE_BEGIN )
			ReadFile( hFile, pAnyBuf, 8, VarPtr(dwReadSize), ByVal NULL )
		SetFilePointer( hFile, 0, NULL, FILE_BEGIN )
		If( (pAnyBuf[0]=&H89) _
			And(pAnyBuf[1]=&H50) _
			And(pAnyBuf[2]=&H4E) _
			And(pAnyBuf[3]=&H47) _
			And(pAnyBuf[4]=&H0D) _
			And(pAnyBuf[5]=&H0A) _
			And(pAnyBuf[6]=&H1A) _
			And(pAnyBuf[7]=&H0A) )Then
			IsPng = TRUE
		Else
			IsPng = FALSE
		EndIf
	EndFunction

	'Pngファイルの縦横サイズを読み取る
	Function GetPngSizeWH( hFile As HANDLE ) As Long
		Dim dwWidth As DWord
		Dim dwHeight As DWord
		DIm dwReadSize As DWord

		SetFilePointer( hFile, 16, NULL, FILE_BEGIN )
		ReadFile( hFile, VarPtr(dwWidth), 4, VarPtr(dwReadSize), ByVal NULL )
		ReadFile( hFile, VarPtr(dwHeight), 4,VarPtr(dwReadSize), ByVal NULL )
		dwWidth = BigEndianToLittleEndian( dwWidth )
		dwHeight = BigEndianToLittleEndian( dwHeight )
		udtPicPixel.cx = dwWidth
		udtPicPixel.cy = dwHeight
	EndFunction


Public
	Sub ReadPics()
		hPicRP = NULL
	EndSub
	Sub ~ReadPics()
		'開放処理
		lpPicture->Release()
		If( hPicRP<>NULL )Then
			DeleteObject( hPicRP )
		EndIf
	EndSub

	'指定された画像ファイルの縦横サイズとビットマップハンドル（Png以外）を得る。
	Function CreatePic( pPicPath As BytePtr ) As Long
		Dim hFile As HANDLE
		Dim hGlobal As HGLOBAL
		Dim pGlobal As VoidPtr
		Dim dwSize As DWord
		Dim dwReadSize As DWord
		Dim IID_IPicture=[&H7BF80980,&HBF32,&H101A,[&H8B,&HBB,&H00,&HAA,&H00,&H30,&H0C,&HAB]] As GUID
		Dim lpStream As LPSTREAM
		Dim iWidth As Long,iHeight As Long
		Dim udtHiMetric As SIZE
		Dim hOle=NULL As HANDLE
		Dim wType As Word

		'ファイルオープン
		hFile = CreateFile( pPicPath, GENERIC_READ, NULL, ByVal NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL )
		If( hFile=INVALID_HANDLE_VALUE )Then
			CreatePic = FALSE
			ExitFunction
		EndIf
		If( IsPng( hFile )=TRUE )Then
			'Pngファイルは別途処理
			CreatePic = GetPngSizeWH( hFile )
			CloseHandle( hFile )
			If( hPicRP<>NULL )Then
				DeleteObject( hPicRP )
			EndIf
			hPicRP = NULL
			ExitFunction
		EndIf
		dwSize = GetFileSize( hFile, NULL )
		hGlobal = GlobalAlloc( GPTR, dwSize )
		pGlobal = GlobalLock( hGlobal )
		ReadFile( hFile, pGlobal, dwSize, VarPtr(dwReadSize), ByVal NULL )
		GlobalUnlock( hGlobal )
		CloseHandle( hFile )

		/* オーパーツ扱い（笑）
			OleLoadPicture()＋IStrem＆IPictureインターフェースを利用して
			Jpeg,Gif,Bmpを読み込む。
			OLE (Object Linking and Embedding)を利用しているみたい。
			クリップボードのヤツ？
			上記IPictureクラスにて定義？ */
		CreateStreamOnHGlobal( hGlobal, TRUE, VarPtr(lpStream) )
		OleLoadPicture( lpStream, dwSize, TRUE, VarPtr(IID_IPicture), VarPtr(lpPicture) )
		lpStream->Release()

		'縦横サイズとビットマップハンドルを得る。
		If( lpPicture )Then
			lpPicture->get_Type( VarPtr(wType) )
			If( wType<>PICTYPE_BITMAP )Then
				'絵でないものは弾く
				CreatePic = FALSE
			Else
				CreatePic = TRUE
				'縦横サイズ
				lpPicture->get_Width( VarPtr(iWidth) )
				lpPicture->get_Height( VarPtr(iHeight) )
				With udtHiMetric
					.cx = iWidth
					.cy = iHeight
				End With
				AtlHiMetricToPixel( VarPtr(udtHiMetric), VarPtr(udtPicPixel) )
				'ビットマップハンドル
				lpPicture->get_Handle( VarPtr(hOle) ) '※成功時の返り値はS_OK(=0)です。
				If( hPicRP<>NULL )Then
					DeleteObject( hPicRP )
				EndIf
				hPicRP = hOle As HBITMAP
			EndIf
		Else
			CreatePic = FALSE
		EndIf
	EndFunction

	'横サイズを返す
	Function GetWidth() As Long
		GetWidth = udtPicPixel.cx
	End Function
	'縦サイズを返す
	Function GetHeight() As Long
		GetHeight = udtPicPixel.cy
	End Function

	'ビットマップハンドルを返す。
	Function GetBmpHandle() As HBITMAP
		GetBmpHandle = hPicRP
	End Function

End Class

ab.com コミュニティ

一般的な画像フォーマットの縦横サイズの取得方法は？

一般的な画像フォーマットの縦横サイズの取得方法は？