|
気がついたら返信頂いていました。
hiraさん、本当にありがとうございます!
ご指摘の通りコードを改良し、さらに別サイトの情報も参考にしたところ、GDI+で画像の読み書きができるようになりました。
といってもGDI+を理解したわけではないので、今のところ
・GIF、PNG、JPG、BMPなどの読み込み
・JPGの出力(品質指定可能)
・PNGの出力(詳細設定不可)
しかできません。
でもPNGを扱えるのでゲームを作る際に容量を削減できるようになりました。
↓読み込み
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
'---------画像読み込み
Declare Function GdiplusStartup Lib "GDIPlus" (ByRef token As Long, ByRef inputbuf As GdiplusStartupInput, ByRef outputbuf As Long) As Long
Declare Function GdiplusShutdown Lib "GDIPlus" (token As Long) As Long
Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (filename As WordPtr,ByRef bitmap As Long) As Long
Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (bitmap As Long,ByRef hbmReturn As HBITMAP,background As Long) As Long
Declare Function GdipDisposeImage Lib "GDIPlus" (image As Long) As Long
Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
'-------↑ここまで宣言
Function GDIPLoadPicture(FilePath As BytePtr) As HBITMAP
Dim buf As WordPtr,size As Long
Dim lngGdiPlusTolen As Long
Dim lngBitmap As Long
Dim gsi As GdiplusStartupInput
Dim lngResult As Long
With gsi
.GdiplusVersion = 1
.DebugEventCallback = 0
.SuppressBackgroundThread = 0
.SuppressExternalCodecs = 0
End With
'FilePathの文字コード変換(Shift-JIS→Unicode)
size=MultiByteToWideChar(CP_ACP,1,FilePath,-1,NULL,NULL)
buf=calloc(size*2)
MultiByteToWideChar(CP_ACP,1,FilePath,-1,buf,size)
'GDI+を使って画像を読み込み
lngResult=GdiplusStartup(lngGdiPlusTolen,gsi,ByVal 0)
If lngResult=0 then
lngResult=GdipCreateBitmapFromFile(buf,lngBitmap)
If lngResult=0 then
'画像データからビットマップハンドル
lngResult=GdipCreateHBITMAPFromBitmap(lngBitmap,GDIPLoadPicture,0)
EndIf
'画像データを破棄
GdipDisposeImage(lngBitmap)
EndIf
'GDI+終了
GdiplusShutdown(lngGdiPlusTolen)
free(buf)
EndFunction
↓保存
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
'---------保存
'「読み込み」のときの宣言に加え、以下が必要
'無理やり型の名前を変え、数値を調節し、とにかくコンパイルが通るようにしたもの。
'むしろ動いてる方が不思議。
'意味の分かる方がいらっしゃったらGIFやBMPも作っていただきたいです。
Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus.dll" (hbm As HBITMAP, hpal As Long, ByRef bitmap As Long) As Long
Declare Function GdipSaveImageToFile Lib "gdiplus.dll" (Image As Long,filename As WordPtr, ByRef clsidEncoder As UUID,ByRef encoderParams As EncoderParameters) As Long
Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4[7] As Byte
End Type
Type EncoderParameter
Guid As UUID
NumberOfValues As Long
eType As Long
Value As VoidPtr
End Type
Type EncoderParameters
Count As Long
Parameter[15] As EncoderParameter
End Type
/*Declare Function CLSIDFromString Lib "ole32" (sGuid As BytePtr, ByRef uuid As UUID) As Long
なぜか動かない
↓代わりに機能を推測して自分で作ってみた
*/
Function CLSIDFromString(sGuid As String, ByRef uuid As UUID) As Long
SelectCase sGuid
Case "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
uuid.Data1=&H557CF406
uuid.Data2=&H1A04
uuid.Data3=&H11D3
uuid.Data4[0]=&H9A
uuid.Data4[1]=&H73
uuid.Data4[4]=&HF8
uuid.Data4[5]=&H1E
uuid.Data4[6]=&HF3
uuid.Data4[7]=&H2E
Case "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
uuid.Data1=&H557CF401
uuid.Data2=&H1A04
uuid.Data3=&H11D3
uuid.Data4[0]=&H9A
uuid.Data4[1]=&H73
uuid.Data4[4]=&HF8
uuid.Data4[5]=&H1E
uuid.Data4[6]=&HF3
uuid.Data4[7]=&H2E
Case "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
uuid.Data1=&H1D5BE4B5
uuid.Data2=&HFA4A
uuid.Data3=&H452D
uuid.Data4[0]=&H9C
uuid.Data4[1]=&HDD
uuid.Data4[2]=&H5D
uuid.Data4[3]=&HB3
uuid.Data4[4]=&H51
uuid.Data4[5]=&H05
uuid.Data4[6]=&HE7
uuid.Data4[7]=&HEB
EndSelect
EndFunction
const CLSID_PNG = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
const CLSID_JPEG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
const CLSID_QUALITY = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
'-------↑ここまで宣言
Sub GDIPSavePNG(FilePath As BytePtr,hBmp As HBITMAP)
Dim buf As WordPtr,size As Long
Dim lngGdiPlusTolen As Long
Dim lngBitmap As Long
Dim gsi As GdiplusStartupInput
Dim lngResult As Long
Dim uuid As UUID
With gsi
.GdiplusVersion = 1
.DebugEventCallback = 0
.SuppressBackgroundThread = 0
.SuppressExternalCodecs = 0
End With
'FilePathの文字コード変換(Shift-JIS→Unicode)
size=MultiByteToWideChar(CP_ACP,1,FilePath,-1,NULL,NULL)
buf=calloc(size*2)
MultiByteToWideChar(CP_ACP,1,FilePath,-1,buf,size)
lngResult=GdiplusStartup(lngGdiPlusTolen,gsi,ByVal 0)
If lngResult=0 then
lngResult=GdipCreateBitmapFromHBITMAP(hBmp,NULL,lngBitmap)
If lngResult=0 then
CLSIDFromString(CLSID_PNG,uuid)
lngResult= GdipSaveImageToFile(lngBitmap,buf,uuid,ByVal 0)
'画像データを破棄
debug
GdipDisposeImage(lngBitmap)
EndIf
EndIf
'GDI+終了
GdiplusShutdown(lngGdiPlusTolen)
free(buf)
EndSub
Sub GDIPSaveJPG(FilePath As BytePtr,hBmp As HBITMAP,Quality As Long)
Dim buf As WordPtr,size As Long
Dim lngGdiPlusTolen As Long
Dim lngBitmap As Long
Dim gsi As GdiplusStartupInput
Dim lngResult As Long
Dim uuid As UUID
Dim EPS As EncoderParameters
With gsi
.GdiplusVersion = 1
.DebugEventCallback = 0
.SuppressBackgroundThread = 0
.SuppressExternalCodecs = 0
End With
'FilePathの文字コード変換(Shift-JIS→Unicode)
size=MultiByteToWideChar(CP_ACP,1,FilePath,-1,NULL,NULL)
buf=calloc(size*2)
MultiByteToWideChar(CP_ACP,1,FilePath,-1,buf,size)
lngResult=GdiplusStartup(lngGdiPlusTolen,gsi,ByVal 0)
If lngResult=0 then
lngResult=GdipCreateBitmapFromHBITMAP(hBmp,NULL,lngBitmap)
If lngResult=0 then
EPS.Count=1
With EPS.Parameter
CLSIDFromString(CLSID_QUALITY,.Guid)
.NumberOfValues = 1
' 4=EncoderParameterValueTypeLong
.eType = 4
' 圧縮品質
.Value = VarPtr(Quality)
End With
CLSIDFromString(CLSID_JPEG,uuid)
lngResult= GdipSaveImageToFile(lngBitmap,buf,uuid,EPS)
'画像データを破棄
GdipDisposeImage(lngBitmap)
EndIf
EndIf
'GDI+終了
GdiplusShutdown(lngGdiPlusTolen)
free(buf)
EndSub
・Function GDIPLoadPicture(FilePath As BytePtr) As HBITMAP
画像を読み込み
FilePath…ファイルパス
戻り値…ビットマップハンドル
・GDIPSavePNG(FilePath As BytePtr,hBmp As HBITMAP)
PNGを保存(上書き)
FilePath…保存先ファイルパス
hBmp…ビットマップハンドル
・GDIPSavePNG(FilePath As BytePtr,hBmp As HBITMAP,Quality As Long)
PNGを保存(上書き)
FilePath…保存先ファイルパス
hBmp…ビットマップハンドル
Quality…品質(0~100?)
↓使用例
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード:
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim hMemDC As HDC,hMemBmp As HBITMAP
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数
Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。
Sub MainWnd_Destroy()
DeleteDC(hMemDC)
DeleteObject(hMemBmp)
gdip_DestroyObjects()
PostQuitMessage(0)
End Sub
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
Dim hDC As HDC
hMemBmp=GDIPLoadPicture(読み込むファイル)
GDIPSavePNG(PNG出力先,hMemBmp)
GDIPSaveJPG(JPG出力先,hMemBmp,50)
hDC=GetDC(hMainWnd)
hMemDC=CreateCompatibleDC(hDC)
ReleaseDC(hMainWnd,hDC)
SelectObject(hMemDC,hMemBmp)
InvalidateRect(hMainWnd,ByVal 0,0)
End Sub
Sub MainWnd_Paint(hDC As HDC)
BitBlt(hDC,0,0,画像幅,画像高,hMemDC,0,0,SRCCOPY)
End Sub
参考
http://www31.ocn.ne.jp/~heropa/vb42.htm
http://hpcgi1.nifty.com/MADIA/VBBBS2/ww ... 080012.txt
|
|