HSPでAeroGlassに描画してみる | Codetter（こーどったー）

#include "a2d.hsp"

#module
#uselib "user32"
#func GetDC "GetDC" int
#func ReleaseDC "ReleaseDC" int,int
#deffunc alSetAeroGlass
	alReleaseAeroGlass
	wid=ginfo_sel
	GetDC hwnd
	dc=stat
	return dc
#deffunc alReleaseAeroGlass onexit
	old_wid=ginfo_sel
	if dc:gsel wid:ReleaseDC hwnd,dc:gsel old_wid
	return 0
#deffunc _alCopyImageToAeroGlass int p1, int x, int y, int w, int h
	if imgValidArr@a2d(p1) {
		; 実スクリーンの Graphics 作成
		gsel wid
		GdipCreateFromHDC@a2d dc, varptr(tmpGraphics)

		if tmpGraphics {
			GdipSetCompositingMode@a2d tmpGraphics, 1
			GdipDrawImageRectRectI@a2d tmpGraphics, imgImageArr@a2d(p1), x, y, w,h, x, y, w,h, UnitPixel@a2d, pImageAttr@a2d, 0, 0
			GdipDeleteGraphics@a2d tmpGraphics	; tmpGraphics を削除
			tmpGraphics = 0
			return 0
		}
	}
	return -1
#global
#define alCopyImageToAeroGlass(%1,%2=ginfo_cx,%3=ginfo_cy,%4=ginfo_winx,%5=ginfo_winy) _alCopyImageToAeroGlass %1,%2,%3,%4,%5

#uselib "dwmapi"
#func DwmIsCompositionEnabled "DwmIsCompositionEnabled" int
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int
	aerorect=-1,0,0,0
	wx=640 : wy=480
	screen 0,wx,wy,2
	cls 4 : gsel 0,1
	gosub *lAeroChk
	oncmd gosub *lAeroChk,0x031E	;Aeroの状態が変わった時
	oncmd gosub *lWRedraw,0x3		;画面外に行った時に消えるので描画しなおす（高負荷なので工夫して）
	alSetAeroGlass
	alCreateImage 0,wx,wy
	repeat 10
	_y=cnt
	repeat 10
	_x=cnt
	alHsvColor ((_y*10+_x)*2)\192,255,100+_y*15,200-_x*15
	alFillRect _x*(wx/10)+1,_y*(wy/10)+1,(wx/10)-1,(wy/10)-1
	loop
	loop
	alFont "meiryo",60 : alColor 0,0,0,255
	alDrawText "そしてこの\n黒文字である\n透けていないでしょ？",0,0,wx,wy,1,1
	repeat
	gosub *lWRedraw
	wait 5	;最小化からの復帰時の再描画がうまくいかないのでとりあえずループ監視
	loop
	stop

*lWRedraw
	// 再描画(Aero環境の場合、画面外にウインドウが行くと再描画が必要)
	if aero{
		alCopyImageToAeroGlass 0
	}else{
		alCopyImageToScreen 0,0
		redraw
	}
	return

*lAeroChk
	DwmIsCompositionEnabled varptr(aero)
	if aero!0{
		color 0,0,0 : boxf
		DwmExtendFrameIntoClientArea hwnd,varptr(aerorect)
		wait 1	;何故かgselでウインドウ表示後ウエイトを入れないと中身が表示されない
				;（生成時のアニメーション中だとだめ？最小化から復帰アニメーション中もだめっぽい）
	}else{
		color 0,0,0 : boxf
	}
	gosub *lWRedraw
	return