ビットマップハンドルを返すクラスです。
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
ただし、DeleteObject()を呼ぶ必要はありません(そのはず・・・)。
ReadPicsクラスが破棄されたor新規読み込みをした時点で勝手に破棄されます。
メソッドは以下の4つです。
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()と置き換えればよいというわけでもないのが困りどころ^^;。