ab.com コミュニティ

全ての表示時間は UTC+09:00 です

[AB4]画像ファイル（BMP,Jpeg,Gif）を読み込むクラス

返信する

ユーザー名:

件名:

メッセージ本文:
メッセージを入力してください。60000 字まで入力できます。

フォントサイズ:
	フォントカラー

オプション:

BBCode: ON

[img]: ON

[flash]: OFF

[url]: ON

スマイリー: OFF

	BBCode を無効にする
	URL を自動的にパースしない

クイズ

お手数ですがカタカナで「エービー」と4文字を入力してください。:
答えを正確に入力してください。答えられるかどうかでスパムボットか否かを判定します。

トピックのレビュー - [AB4]画像ファイル（BMP,Jpeg,Gif）を読み込むクラス

作成者

メッセージ

淡幻星

記事の件名:

あれ？

引用付きで返信する

えっと。
実行されないIf文の中の未宣言変数の扱い、
以前(Ver.4.10.02)はコンパイルエラーしなかったんですが、
現在(Ver.4.23.00)はエラーとして弾かれる仕様になったみたいですね。

上記のクラスをN88BASICモード以外で利用する場合は、
クラス定義をインクルードする前にモジュールレベルで
Dim _PromptSys_hWnd As Long
の一行を追加してください。
暫定処置です。
そのうちクラスの定義の方をエラーしないように直したいと思います。

投稿記事

Posted: 2006年3月21日(火) 17:06

淡幻星

記事の件名:

クラスWsEasyBmpとくっつけてみました。

引用付きで返信する

WsEasyBmpの中にReadPicsクラスを含めるの、思ったよりも簡単にできました。＾＾；

クラスWsEasyBmpをBMPだけでなくJpeg,Gifも扱えるように拡張した、クラスWsEasyPicsです。

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

コード:

'クラスWsEasyBmpとクラスWsReadPicsの定義はインクルードしてあることを前提とします。
Class WsEasyPics
	Inherits WsEasyBmp
	pObjWsReadPics As *WsReadPics

Public
	Sub WsEasyPics( hWnd As HWND )
		pObjWsReadPics = New WsReadPics( hWnd )
		If( hWnd=NULL )Then
			'N88BASICモード用
			SetBasic()
		Else
			SetTargetWindow( hWnd )
		End If
	End Sub
	Sub ~WsEasyPics()
		Delete pObjWsReadPics
	End Sub


	Function BloadPics( pBmpFile As BytePtr ) As Long
		Dim hBmp As HBITMAP

		BloadPics = pObjWsReadPics->CreatePic( pBmpFile )
		hBmp = pObjWsReadPics->GetBmpHandle()
		If( hBmp<>NULL )Then
			SetHandleBmp( hBmp )
		End If
	End Function

End Class

使い方はクラスWsEasyBmpとほぼ一緒です。
違うのは２点。
・オブジェクト宣言時にNULL（N88BASICモード時）かメイン窓のウインドウハンドル（hMainWnd）を渡す必要があること。
　　【例】
　　Dim lp As WsEasyPics(NULL)
　　Dim lp As WsEasyPics(hMainWnd)
・画像読み込みにはBload()ではなく、BloadPics()を使うこと。
　　Function BloadPics( pBmpFile As BytePtr ) As Long
以上。
クラスWsEasyBmpで使えたメソッドは全て同様に使えます。
よって、読み込んで、表示して、切り出して、貼り付けて、が簡単にできます。
でも残念ながら保存は相変わらずBMPのみです。＾＾；

投稿記事

Posted: 2006年3月20日(月) 02:55

淡幻星

記事の件名:

[AB4]画像ファイル（BMP,Jpeg,Gif）を読み込むクラス

引用付きで返信する

BMP,Jpeg,Gifの３種類の画像ファイルを読み込み、
ビットマップハンドルを返すクラスです。
Pngも縦横サイズだけは取得できるようにしています。
（※Pngのビットマップハンドルは得られません。）
もともとはビットマップハンドルよりも縦横サイズを得るのが目的だったためです＾＾；

hira様のコードを利用させて頂いております。

クラスにまとめたので、仕組みを理解せずに利用できるのがポイントかと♪

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

コード:

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)


'クラスReadPicsで利用する定数
Const PicType_BMP = 1
Const PicType_Jpeg = 2
Const PicType_Gif = 3
Const PicType_Png = 4
Const PicType_Unknow = NULL



'Jpeg,Gif(,Bmp)のビットマップハンドル読み込みと縦横サイズ取得
'  ＋Pngの縦横サイズ取得を行うクラス。
Class WsReadPics
	udtPicPixel As SIZE '画像の縦横サイズ
	nPicType As Long '画像のタイプ（BMP,Jpeg,Gif,Png）
	lpPicture As LPPICTURE 'IPictureインターフェース（クラスに分類してよい？）
	hBmpRP As HBITMAP 'BMPの場合はIPictureインターフェースを使わずに直にビットマップハンドルを利用。
	hOwnerWnd As HWND '呼び出す親窓。アプリケーションのインスタンスハンドルを得るために利用。

	'フラグの初期化やオブジェクトの破棄。
	Sub RP_DeletePicObject()
		If( hBmpRP<>NULL )Then
			DeleteObject( hBmpRP )
		End If
		hBmpRP = NULL
		If( (nPicType=PicType_Jpeg)Or(nPicType=PicType_Gif) )Then
			lpPicture->Release()
		EndIf
		nPicType = NULL
		udtPicPixel.cx = 0
		udtPicPixel.cy = 0
	End Sub


Public '-------------------------------------------------------------------------------
	Sub WsReadPics( hWnd As HWND )
		If( hWnd=NULL )Then
			'N88BASICモードと判断
			hOwnerWnd = _PromptSys_hWnd
		Else
			'それ以外のとき
			hOwnerWnd = hWnd
		EndIf
		nPicType = NULL
		hBmpRP = NULL
	EndSub
	Sub ~WsReadPics()
		'開放処理
		RP_DeletePicObject()
	EndSub

	'指定された画像ファイルの縦横サイズとビットマップハンドル（Png以外）を得る。
	Function CreatePic( pPicPath As BytePtr ) As Long
		Dim hFile As HANDLE

		'ファイルオープン
		hFile = CreateFile( pPicPath, GENERIC_READ, NULL, ByVal NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL )
		If( hFile=INVALID_HANDLE_VALUE )Then
			CreatePic = FALSE
			ExitFunction
		Else
			RP_DeletePicObject() '新規読み込みの前処理
		EndIf

		'画像タイプによって動作分岐
		nPicType = WhatPicType( hFile )
		If( nPicType=PicType_BMP )Then
			CloseHandle( hFile )
			CreatePic = LoadBmpJust( hOwnerWnd, pPicPath )
		Else
			Select Case nPicType
				Case PicType_Unknow
					'※対応している画像ファイルではないので読み込み処理は行わない。
					CreatePic = FALSE
				Case PicType_Png
					CreatePic = GetPngSizeWH( hFile )
				Case Else
					'PicType_JpegとPicType_Gifがここに来る。
					CreatePic = LoadPictureWithIPicture( hFile )
			End Select
			CloseHandle( hFile )
		End If

	EndFunction


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

	'ビットマップハンドルを返す。
	Function GetBmpHandle() As HBITMAP
		Dim hOle=NULL As HANDLE

		Select Case nPicType
			Case PicType_Unknow
				GetBmpHandle = NULL
			Case PicType_Png
				GetBmpHandle = NULL
			Case PicType_BMP
				GetBmpHandle = hBmpRP
			Case Else 'PicType_JpegとPicType_Gifがここに来る。
				lpPicture->get_Handle( VarPtr(hOle) ) '※成功時の返り値はS_OK(=0)です。
				GetBmpHandle = hOle As HBITMAP
		End Select
	End Function


Private '-------------------------------------------------------------------------------
	'画像ファイルの種類を定数(Bmp,Jpeg,Gif,Png)で返す。
	Function WhatPicType( 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 )

		If( (pAnyBuf[0]=&H42)And(pAnyBuf[1]=&H4D) )Then
			WhatPicType = PicType_BMP
		Else
			If( (pAnyBuf[0]=&H47)And(pAnyBuf[1]=&H49)And(pAnyBuf[2]=&H46) )Then
				WhatPicType = PicType_Gif
			Else
				If( (pAnyBuf[0]=&HFF)And(pAnyBuf[1]=&HD8) )Then
					WhatPicType = PicType_Jpeg
				Else
					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
						WhatPicType = PicType_Png
					Else
						WhatPicType = NULL
					EndIf
				End If
			End If
		End If

		SetFilePointer( hFile, 0, NULL, FILE_BEGIN )
	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


	'IPictureインターフェースを利用した画像ファイルの読み込み。（Jpeg,Gifで利用）
	Function LoadPictureWithIPicture( hFile As HANDLE ) As Long
		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 wType As Word

		'ファイル内容を読み取る。
		dwSize = GetFileSize( hFile, NULL )
		hGlobal = GlobalAlloc( GPTR, dwSize )
		pGlobal = GlobalLock( hGlobal )
		ReadFile( hFile, pGlobal, dwSize, VarPtr(dwReadSize), ByVal NULL )
		GlobalUnlock( hGlobal )

		/* オーパーツ扱い（笑）
			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
				'念のため、ここでも絵でないものは弾く
				LoadPictureWithIPicture = FALSE
			Else
				LoadPictureWithIPicture = TRUE
				'縦横サイズの取得とピクセルサイズへの変換
				lpPicture->get_Width( VarPtr(iWidth) )
				lpPicture->get_Height( VarPtr(iHeight) )
				With udtHiMetric
					.cx = iWidth
					.cy = iHeight
				End With
				AtlHiMetricToPixel( VarPtr(udtHiMetric), VarPtr(udtPicPixel) )
			EndIf
		Else
			LoadPictureWithIPicture = FALSE
		EndIf

		SetFilePointer( hFile, 0, NULL, FILE_BEGIN )
	End Function


	'LoadImageを利用してBMPを読み込む（※このAPIが使えるなら、IPictureより早いため。）
	Function LoadBmpJust( hWnd As HWND, pPicPath As BytePtr ) As Long
		Dim lp As BITMAP

		hBmpRP = LoadImage( GetWindowLong(hWnd, GWL_HINSTANCE) As HINSTANCE, pPicPath, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE )
		If( hBmpRP=NULL )Then
			LoadBmpJust = FALSE
		Else
			LoadBmpJust = TRUE
			GetObject( hBmpRP, Len(lp), lp )
			udtPicPixel.cx = lp.bmWidth
			udtPicPixel.cy = lp.bmHeight
		End If
	End Function

End Class

【利用例】

コード:

#N88BASIC

Dim lp As ReadPics(NULL) 'N88BASICモード以外では、メイン窓のウィンドウハンドル（hMainWnd）を引数に渡してください。
Dim hPic As HBITMAP

lp.CreatePic( "hoge.jpeg" ) 'ファイルパスから画像ファイルを読み込みます。
hPic = lp.GetBmpHandle() 'ビットマップハンドルを返します。
Print " ("; lp.GetWidth(); "x"; lp.GetHeight(); ")" '縦横サイズを表示

End

取得したビットマップハンドルはLoadImage()などで得たものと全く同様に利用できます。
ただし、DeleteObject()を呼ぶ必要はありません（そのはず･･･）。
ReadPicsクラスが破棄されたor新規読み込みをした時点で勝手に破棄されます。

メソッドは以下の４つです。
Function CreatePic( pPicPath As BytePtr ) As Long
　　画像ファイルの読み込み。引数はファイルのフルパス。
　　成功ならTRUE、失敗ならFALSE。

Function GetWidth() As Long
　　横サイズを返す。

Function GetHeight() As Long
　　縦サイズを返す。

Function GetBmpHandle() As HBITMAP
　　ビットマップハンドルを返す。
　　失敗時はNULL。

WsEasyBmpクラスと組み合わせれば、
N88BASICモードでも簡単に画像の読み込みと表示が出来ます。
【サンプル】※それぞれのクラス定義はインクルードしてあるとします。

コード:

#N88BASIC

Dim lpPic As WsEasyBmp
lpPic.SetBasic()

Dim lp As ReadPics(NULL)

lp.CreatePic( "hoge.jpeg" )
lpPic.SetHandleBmp( lp.GetBmpHandle() )
lpPic.PutBmp( 16, 32 , PSet_BASIC )

Input s
End

ただ･･･それぞれのクラス内でビットマップハンドルを勝手に自動破棄してしまうので、
タイミングが読みづらいかもしれません･･･。

そのうち、WsEasyBmpの中にReadPicsクラスを含めてしまいたいところです。
ビットマップハンドルの破棄のタイミングの問題で、
LoadImage()と置き換えればよいというわけでもないのが困りどころ＾＾；。

投稿記事

Posted: 2006年3月19日(日) 23:36

掲示板トップ » »

全ての表示時間は UTC+09:00 です