コード: 全て選択
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