'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [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

'---------画像読み込み

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

' ウィンドウ ハンドル: 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