aeroのタグがつけられたコード一覧

HSP HSPでAeroGlassに描画してみる(オブジェクト編)

#include "user32.as"
#define GWL_WNDPROC -4
#define WM_CREATE 0x1
#define WM_DESTROY 0x2

#uselib "uxtheme"
#cfunc BeginBufferedPaint "BeginBufferedPaint" int,int,int,int,int
#func EndBufferedPaint "EndBufferedPaint" int,int
#func BufferedPaintSetAlpha "BufferedPaintSetAlpha" int,int,int
#func BufferedPaintRenderAnimation "BufferedPaintRenderAnimation" int,int
#define BPBF_TOPDOWNDIB 2

#uselib "dwmapi"
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int

#include "hscallbk.as"
#uselib ""
#func CallNew "" int,int,int,int

	;-- いつもの
	screen 0,580,160
	r=0,0,80,0
	DwmExtendFrameIntoClientArea hwnd,varptr(r)
	cls 4

	;-- コールバック関数
	setcallbk ProcNew, CallNew, *lCallNewWindowProc

	objx=200
	objy=50
	objsize objx,objy
	objmode 2,1 : font "meiryo",24,1+16	;-- みんな大好きメイリオ

	pos  10,10 : button gosub "透けるボタン",*lButton

	;-- ボタンのサブクラス化
	pos 310,10 : button gosub "透けないボタン",*lButton
	hButton=objinfo(stat,2)
	GetWindowLong hButton,GWL_WNDPROC
	dButtonProc=stat
	SetWindowLong hButton,GWL_WNDPROC,varptr(ProcNew)

	stop

*lButton
	dialog "Push"
	return
*lCallNewWindowProc
	if callbkarg(0)=hButton{	;--該当ボタン
		;-- WM_PAINT以外は通常通りの動作をする
		CallWindowProc dButtonProc,callbkarg(0),callbkarg(1),callbkarg(2),callbkarg(3)
		ret=stat
		if callbkarg(1)=0xf{	;--WM_PAINT
			r=5,5,objx-5,objy-5	;-- ボタンの角が円いので少し小さめにしておかないと余計な部分まで不透明になる
								;   ……はずなのだが、HSPのボタンはなぜか下地が見えちゃってるので意味なし
			pp=16,0,0,0
			mhdc=0
			GetWindowDC hButton
			dcButton=stat
			pb=BeginBufferedPaint(dcButton,varptr(r),BPBF_TOPDOWNDIB,varptr(pp),varptr(mhdc))
			if pb!0{
				CallWindowProc dButtonProc,callbkarg(0),callbkarg(1),mhdc,callbkarg(3)
				ret=stat
				BufferedPaintSetAlpha pb,varptr(r),255
				EndBufferedPaint pb,1
			}
			ReleaseDC hButton,dcButton
		}
	}
	return ret

HSP HSPでAeroGlassに描画してみる

#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

よく投稿されているコード

タグ

最近投稿されたコード