先日の「ドラッグできる矩形の表示」をちょっと改造して、ドラッグできるメッセージボックス・ボタン・チェックボックスを作成。RADツールのようになりました。ID1のスクリーンに実際のオブジェクトを配置し、BitBltでID0のスクリーンにコピーしています。
なぜ「失敗作」扱いかというと、ID1のスクリーンを非表示あるいは画面外としたかったのですが、その状態でBitBltを正常に動作させる方法が分からなかったため。オブジェクト同士を重ね合わせた時の描画も少々おかしいです。// RADツールサンプル
#include "obj.as"
// 矩形を扱うモジュール
#module mdl_rect x, y, w, h, id
#const BORDER_WIDTH 2
#modinit int _x, int _y, int _w, int _h, int _id
x = _x : y = _y
w = _w : h = _h
id = _id
return
//
// 矩形を移動
#modfunc move_rect int _x, int _y
x = _x : y = _y
v = w, h, x, y
resizeobj id, v
return
//
// 点(px, py)が矩形内にあるか否かを返す
#modfunc point_rect int px, int py
return ( x <= px ) & ( y <= py ) & ( px < x + w ) & ( py < y + h )
//
// 矩形のX座標を返す
#modfunc get_x var ret
ret = x
return
//
// 矩形のY座標を返す
#modfunc get_y var ret
ret = y
return
//
// 今ポイントしている矩形を調べ、その配列要素番号をstatに返す(なにもない時は-1)
#deffunc get_pointing_rect array rects, local result
result = -1
foreach rects
point_rect rects( cnt ), mousex, mousey
if stat : result = cnt
loop
return result
#global
// 操作先ウィンドウに指定idのスクリーンをコピー
// (参考:http://yokohama.cool.ne.jp/chokuto/advanced/capturewindow.html)
#module
#uselib "user32.dll"
#cfunc GetDC "GetDC" sptr
#func ReleaseDC "ReleaseDC" sptr,sptr
#uselib "gdi32.dll"
#func BitBlt "BitBlt" sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr
#const SRCCOPY 0xCC0020
#deffunc copy_window int source_id
dim rect, 4
target_id = ginfo_sel
target_hdc = GetDC( hwnd )
gsel source_id
source_hdc = GetDC( hwnd )
BitBlt target_hdc, 0, 0, ginfo_winx, ginfo_winy, source_hdc, 0, 0, SRCCOPY
ReleaseDC hwnd, source_hdc
gsel target_id
ReleaseDC hwnd, target_hdc
return
#global
// マウスカーソル変更用命令(参考:http://lhsp.s206.xrea.com/hsp_mouse.html#3)
#uselib "user32.dll"
#cfunc LoadCursor "LoadCursorA" nullptr, int
#func SetClassLong "SetClassLongA" int, int, int
// ウィンドウメッセージ
#const WM_LBUTTONDOWN 0x0201
#const WM_LBUTTONUP 0x0202
#const WM_MOUSEMOVE 0x0200
// LoadCursor用引数
#const IDC_ARROW 0x7F00
#const IDC_HAND 0x7F89
*init
randomize
s_mesbox = "メッセージボックス"
screen 1, ginfo_winx, ginfo_winy, SCREEN_NORMAL, ginfo_wx1, ginfo_wy1
// オブジェクトの配置
repeat 5
w = rnd( 100 ) + 100 : h = rnd( 100 ) + 50
x = rnd( ginfo_winx - w ) : y = rnd( ginfo_winy - h )
pos x, y : objsize w, h
if ( cnt == 0 ) {
mesbox s_mesbox
} else : if ( cnt < 3 ){
button "ボタン" + ( cnt ), *dummy
} else : if ( cnt < 5 ){
chkbox "チェックボックス" + ( cnt - 2 ), f_chkbox
}
newmod rects, mdl_rect, x, y, w, h, stat
loop
gsel 0, 2 // ID1のスクリーンを隠すために最前面へ表示
oncmd gosub *LButtonDown, WM_LBUTTONDOWN
oncmd gosub *LButtonUp, WM_LBUTTONUP
oncmd gosub *MouseMove, WM_MOUSEMOVE
cursor_type = IDC_ARROW
gosub *renew_screen
stop
//
// 画面の更新
*renew_screen
gsel 0 : copy_window 1
return
//
// マウスの左ボタンを離した時の処理
*LButtonUp
dragging = 0 // ドラッグ終了
return
//
// マウスの左ボタンを押した時の処理
*LButtonDown
if ( pointing_rect >= 0 ) {
// 矩形をポイントしている場合はその矩形をドラッグする
dx = mousex : dy = mousey
dragging = 1
}
return
//
// マウスが動いたときの処理
*MouseMove
mx = mousex : my = mousey
if ( pointing_rect >= 0 ) & ( cursor_type != IDC_HAND ) {
// 矩形の上ではカーソルを手の形に変更
cursor_type = IDC_HAND
gosub *ChangeCursor
}
if ( pointing_rect < 0 ) & ( cursor_type != IDC_ARROW ) {
// 矩形の外ではカーソルを通常の形に変更
cursor_type = IDC_ARROW
gosub *ChangeCursor
}
if dragging {
// ドラッグ中ならば矩形を移動
get_x rects( pointing_rect ), x
get_y rects( pointing_rect ), y
gsel 1 : move_rect rects( pointing_rect ), x + mx - dx, y + my - dy
dx = mx : dy = my
} else {
// ドラッグ中でないならばポイントしている矩形を調べる
get_pointing_rect rects
pointing_rect = stat
}
// 画面を更新
gosub *renew_screen
return
//
// マウスカーソルの変更
*ChangeCursor
SetClassLong hwnd, -12, LoadCursor( cursor_type )
mouse // マウスカーソルの更新(これがないと即座に反映されない)
return
//
// ダミーラベル(ボタン用)
*dummy
stop
2007年9月6日木曜日
RADツールサンプル(失敗作)
登録:
コメントの投稿 (Atom)
0 件のコメント:
コメントを投稿