ab.com コミュニティ

by **ShellExecute** » 2013年1月16日(水) 18:55

連続ですみません

上記コードの説明３個目
・GDIPSavePNG(FilePath As BytePtr,hBmp As HBITMAP,Quality As Long)
PNを保存

とありますが、正しくは
・GDIPSaveJPG(FilePath As BytePtr,hBmp As HBITMAP,Quality As Long)
JOGを保存

です。失礼しました。

by **ShellExecute** » 2013年1月16日(水) 18:50

気がついたら返信頂いていました。

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

by **hira** » 2013年1月14日(月) 01:18

ここのフォーラムも超久しぶりです。

GDI+のファイル名指定はUnicodeでやらないとだめなようです。
MultiByteToWideChar(CP_ACP, ...) で Shift-JIS → Unicode の変換ができます。

by **ShellExecute** » 2012年12月10日(月) 13:01

http://www31.ocn.ne.jp/~heropa/vb42.htm
↑のページのコードをABに移植すればimgctl.dllなどの外部DLLなしでPNGやJPGを読めるんじゃないか、と思ってコードを作ってみました。

しかし、私VBに一度も触れたことが無いので上手くできていないのか、何も表示されません。

どなたか間違いの指摘をお願いします。

以下に私のコードを載せておきます。ややこしいのでエラーメッセージ取得の部分は省いてありますが
DEBUG_A、DEBUG_Bの箇所で調べるとどちらも
「指定されたファイルが見つかりません」
とでてきます。

ファイルパスの部分は相対パス絶対パスともに試しました。

画像は手元にあったpng、jpg、bmpで試しました。

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

コード: 全て選択


'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。

'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

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)
	aa_DestroyObjects()
	PostQuitMessage(0)
End Sub

'http://www31.ocn.ne.jp/~heropa/vb42.htm
Type GdiplusStartupInput
	GdiplusVersion As Long
	DebugEventCallback As Long
	SuppressBackgroundThread As Long
	SuppressExternalCodecs As Long
End Type
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 BytePtr, _
                                 ByRef bitmap As Long) As Long
Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" _
                                (bitmap As Long, _
                                 ByRef hbmReturn As Long, _
                                 background As Long) As HBITMAP
Declare Function GdipDisposeImage Lib "GDIPlus" _
                                (image As Long) As Long

Function LoadPNGPicture(strFileName As String) As HBITMAP
	Dim gsi As GdiplusStartupInput,A As String
	Dim lngResult As Long
	Dim lngGdiPlusTolen As Long
	Dim lngBitmap As Long
	Dim hBitmap As Long

' 構造体初期化
	With gsi
		.GdiplusVersion = 1
		.DebugEventCallback = 0
		.SuppressBackgroundThread = 0
		.SuppressExternalCodecs = 0
	End With

' GDI+初期化
	lngResult = GdiplusStartup(lngGdiPlusTolen, gsi,ByVal 0)
	If lngResult = 0 Then
' イメージファイルの読み込み
		lngResult = GdipCreateBitmapFromFile(StrPtr(strFileName), lngBitmap)
		If lngResult = 0 Then
' GDIビットマップハンドルを作成する
			LoadPNGPicture= GdipCreateHBITMAPFromBitmap(lngBitmap, hBitmap, 0)
' 取得したイメージを開放する。
			GdipDisposeImage(lngBitmap)
		End If
		GdiplusShutdown(lngGdiPlusTolen)
	End If
'DEBUG_A
End Function

Dim hMemDC As HDC,hMemBmp As HBITMAP

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	Dim hDC As HDC,path As String
	path="data.png"

	hDC=GetDC(hMainWnd)
	hMemDC=CreateCompatibleDC(hDC)
	hMemBmp=LoadPNGPicture(path)
	SelectObject(hMemDC,hMemBmp)
	ReleaseDC(hMainWnd,hDC)
'DEBUG_B
End Sub

Sub MainWnd_Paint(hDC As HDC)
	BitBlt(hDC,0,0,700,600,hMemDC,0,0,SRCCOPY)
End Sub

ab.com コミュニティ

GDI+で色々な形式の画像を表示

返信する

展開ビュートピックのレビュー: GDI+で色々な形式の画像を表示

ありがとうございます！

Re: GDI+で色々な形式の画像を表示

GDI+で色々な形式の画像を表示

GDI+で色々な形式の画像を表示

返信する

展開ビュー トピックのレビュー: GDI+で色々な形式の画像を表示

ありがとうございます！

Re: GDI+で色々な形式の画像を表示

GDI+で色々な形式の画像を表示

展開ビュートピックのレビュー: GDI+で色々な形式の画像を表示