colorfulobject.as [からふるおぶじぇくとLiteモジュール]

;*******************************************************************************
; からふるおぶじぇくとLiteモジュール by 月影とも さん (colorfulobject)
;   modified by abo 2007.09.20
;*******************************************************************************
#ifdef __hsp30__
#ifndef __COLORFULOBJECT__
#define __COLORFULOBJECT__

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

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

;#uselib "gdi32.dll"
;   #func   global CreateSolidBrush "CreateSolidBrush" sptr
;   #func   global DeleteObject "DeleteObject" sptr
;   #func   global SetBkColor "SetBkColor" sptr,sptr
;   #func   global SetTextColor "SetTextColor" sptr,sptr
;#uselib "user32.dll"
;   #func   global InvalidateRect "InvalidateRect" sptr,nullptr,sptr
;   #func   global GetClassName "GetClassNameA" sptr,sptr,sptr
;   #func   global GetComboBoxInfo "GetComboBoxInfo" sptr,sptr
;#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)

#deffunc objcolor int objid, int bkcl, int txcl
    _objcolor_add objid,bkcl,txcl, ginfo_sel
    sdim classname,64
    GetClassName objid,varptr(classname),64
    if ClassName="ComboBox" {
        dim comboboxinfo,20:comboboxinfo=52
        GetComboBoxInfo objid,varptr(comboboxinfo)
        _objcolor_add comboboxinfo.12 ,bkcl,txcl,ginfo_sel
    }
    InvalidateRect objid,"",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_

#endif
#endif

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

#if 0 ;// サンプルここから 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

;--------------------------------------------------------------- (EOF) ---------