2006/01/10(Tue)からふるおぶじぇモジュール

はてブ数 2006/01/10 17:10 プログラミング::HSP3 つーさ

カラフルメッセージボックスの改良版です。

HSPのオブジェクトに色を付けることができます。
オブジェクトごとに別の色を指定できます。

HSP2版で対応していたボタンの色変えについては今のところ対応していません。
誰かに付けてって言われたら付けるかもしれません。

このモジュールはスクリプトに組み込んで自由に使用できます。

#module
;// からふるおぶじぇくとLite  HSP3移植版

#define MAXOBJ 256
;// オブジェクト最大数 (全ウィンドウ合計)
;// 登録したオブジェクトの数だけGDIの論理ブラシを作るので、
;// (システムリソースを食う) あんまり大きくしすぎない方向で。
;// cls 命令などでオブジェクトをクリアしたらその後 objcolorcls命令も実行して、
;// オブジェクトの登録を解除してあげてください。
;// ps.コンボボックスは2個食います。

#uselib "gdi32.dll"
#func SetBkColor "SetBkColor" int,int
#func SetTextColor "SetTextColor" int,int
#func CreateSolidBrush "CreateSolidBrush" int
#func DeleteObject "DeleteObject" int
#uselib "user32.dll"
#func InvalidateRect "InvalidateRect" int,int,int
#func GetClassName "GetClassNameA" int,var,int
#func GetComboBoxInfo "GetComboBoxInfo" int,var
#define WM_CTLCOLOREDIT                 0x0133
#define WM_CTLCOLORLISTBOX              0x0134
#define WM_CTLCOLORSTATIC               0x0138
#define global ctype crgb(%1,%2,%3) (((%1&$FF)<<16)|((%2&$FF)<<8)|(%3&$FF))
#define ctype crgb2colorref(%1) (((%1>>16)&$FF)|(%1&$FF00)|((%1&$FF)<<16))

*colorfulmsgboxproc
	_id = -1
	repeat MAXOBJ
        if hWndObj.cnt == lParam : _id = cnt:break
    loop
    if _id = -1 : return 0
	SetTextColor wParam, txcolor._id
	SetBkColor wParam, bkcolor._id
	return hBrush._id

#deffunc _objcolor_search_objid int _hObj
	_id = -1
	repeat MAXOBJ
		if hWndObj.cnt == _hObj : _id = cnt : break
	loop
	if _id != -1 : return _id
	repeat MAXOBJ
		if hWndObj.cnt == 0 : _id = cnt : break
	loop
	return _id

#deffunc _objcolor_add int hObj,int bkcl,int txcl,int wid
    if hObj = 0 : return
    _objcolor_search_objid hObj : id = stat
    if id=-1 : dialog "オブジェクト数が"+MAXOBJ+"を超えました。" : end

    if hWndObj.id : DeleteObject hBrush.id
    hWndObj.id = hObj
    CreateSolidBrush bkcl : hBrush.id = stat
    bkcolor.id = bkcl
    txcolor.id = txcl
    objwinid.id = wid
    return

#deffunc _objcolor_del int hObj
    if hObj = 0 : return
    _objcolor_search_objid hObj: id = stat
    if id = -1 : return

    if hWndObj.id : DeleteObject hBrush.id
    hWndObj.id = 0
return

#deffunc _clmesbox_init_
	dim hWndObj,MAXOBJ
	dim objwinid,MAXOBJ
	dim hBrush,MAXOBJ
	dim bkcolor,MAXOBJ
	dim txcolor,MAXOBJ
return

#deffunc objcolorscreen
	oncmd gosub *colorfulmsgboxproc,WM_CTLCOLOREDIT
	oncmd gosub *colorfulmsgboxproc,WM_CTLCOLORLISTBOX
	oncmd gosub *colorfulmsgboxproc,WM_CTLCOLORSTATIC
return

#deffunc objcolorcls
	repeat MAXOBJ
		if hWndObj.cnt = 0 : continue
		if objwinid.cnt = ginfo_sel : _objcolor_del hWndObj.cnt
	loop
	return

#deffunc objcolor int objid, int _bkcl, int _txcl
    bkcl = crgb2colorref(_bkcl)
    txcl = crgb2colorref(_txcl)

	_objcolor_add objinfo(objid,2),bkcl,txcl, ginfo_sel
	sdim classname,64
	GetClassName objinfo(objid,2),classname,64
	if ClassName="ComboBox" {
		dim comboboxinfo,20:comboboxinfo=52
		GetComboBoxInfo objinfo(objid,2),comboboxinfo
		_objcolor_add comboboxinfo.12 ,bkcl,txcl,ginfo_sel
	}
	InvalidateRect objinfo(objid,2), 1
return

#deffunc ColorfulMesbox2 int objid, array c
    objcolor objid, crgb(c.0,c.1,c.2), crgb(c.3,c.4,c.5)
return

#global
_clmesbox_init_

;//////// モジュールここまで ////////

#if 1 ;// サンプルここから 1 にすると実行

	objcolorscreen 
	;// 操作先のウィンドウでオブジェクトの色をかえられるようにする。
	
	sdim teststr,1024
	teststr = "からふるおぶじぇくと Lite HSP3移植版\\n"
	teststr+= "オブジェクトごとに\\n色をかえられます♪"
	sdim buf,1024 : buf = teststr
	color $CC,$CC,$CC : boxf
	
	;// HSP2 の objmode +32 みたいに、枠を消せると綺麗なんだけどねぇ。
	objmode 1 : objsize 600,20
	pos 20,0
	;// オブジェクトIDと色の入った配列変数で作成。
	pos , ginfo_cy+20 : mesbox buf,,90,1
	col = $FF,$ee,$ee, $AA,$33,$44
	ColorfulMesbox2 stat,col ;// オブジェクト情報を登録
	
	;// crgbマクロ(COLORREF)による色の指定。
	pos , ginfo_cy+20 : mesbox buf,,90,1
	;// オブジェクト情報を登録 ( ColorfulMesbox2 の実値版 )
	objcolor stat, crgb($FF,$FF,$ee), crgb($AA,$33,$44) 
	
	;// インプットボックス 単に $RRGGBB でも○
	buf = strmid(teststr,0,instr(teststr,0,"\\n")) + " - これは input 入力ボックス 抹茶味(?)"
	pos , ginfo_cy+20 : input buf
	objcolor stat, $eeFFee, $008040
	
	;// 書き換え不可。
	buf = teststr+"\\n\\nこれは書き換え不可エディットボックスです。"
	pos , ginfo_cy+20 : mesbox buf,,90,0
	objcolor stat, crgb($ee,$FF,$FF), crgb($33,$44,$cc)
	
	;// チェックボックスもおっけー
	pos , ginfo_cy+20 : chkbox strmid(teststr,0,instr(teststr,0,"\\n"))+ " - これは チェックボックス" ,a
	objcolor stat, crgb($ee,$ee,$FF), crgb($44,$33,$AA)
	
	;// コンボボックス
	buf = teststr + "\\n\\nこれはみてのとおり\\nコンボボックスです。"
	pos , ginfo_cy+20 : combox a,300,buf
	objcolor stat,$FFeeFF,$AA3344
	
	stop
#endif