ab.com コミュニティ https://www.activebasic.com/forum/ |
|
GDI+で色々な形式の画像を表示 https://www.activebasic.com/forum/viewtopic.php?t=3627 |
ページ 1 / 1 |
作成者: | ShellExecute [ 2012年12月10日(月) 13:01 ] |
記事の件名: | GDI+で色々な形式の画像を表示 |
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 |
作成者: | hira [ 2013年1月14日(月) 01:18 ] |
記事の件名: | Re: GDI+で色々な形式の画像を表示 |
ここのフォーラムも超久しぶりです。 GDI+のファイル名指定はUnicodeでやらないとだめなようです。 MultiByteToWideChar(CP_ACP, ...) で Shift-JIS → Unicode の変換ができます。 |
作成者: | 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 [ここをクリックすると内容が表示されます]
・Function GDIPLoadPicture(FilePath As BytePtr) As HBITMAPコード: '---------保存 '「読み込み」のときの宣言に加え、以下が必要 '無理やり型の名前を変え、数値を調節し、とにかくコンパイルが通るようにしたもの。 'むしろ動いてる方が不思議。 '意味の分かる方がいらっしゃったら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 画像を読み込み 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 |
作成者: | ShellExecute [ 2013年1月16日(水) 18:55 ] |
記事の件名: | |
連続ですみません 上記コードの説明3個目 ・GDIPSavePNG(FilePath As BytePtr,hBmp As HBITMAP,Quality As Long) PNを保存 とありますが、正しくは ・GDIPSaveJPG(FilePath As BytePtr,hBmp As HBITMAP,Quality As Long) JOGを保存 です。失礼しました。 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |