HSPでAeroGlassに描画してみる（オブジェクト編） | Codetter（こーどったー）

#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