GoFのCommandパターンにヒントを得て作成。
描画した履歴を文字列型配列変数に記録しておき、必要に応じて取り出します。
今回は単純な文字列型配列変数ではなく、スタックのモジュールを用意してみました。
bregexp.dll（bregonig.dll）および月影ともさんのbregexp.hspが必要です。// 文字列用スタック
#module string_stack stack, max
#modinit
max = 0
sdim stack, 32, 10
return
#deffunc new_sstack array v
newmod v, string_stack@
return
#modfunc push str s
stack(max) = s
max++
return
#defcfunc pop modvar string_stack@
if max == 0 {
logmes "引数の値が異常です。"
return ""
}
max--
return stack(max)
#defcfunc get_length modvar string_stack@
return max
#defcfunc get_last modvar string_stack@
return stack(max-1)
#defcfunc get_at modvar string_stack@, int index
if index < 0 || max <= index {
logmes "引数の値が異常です。"
return ""
}
return stack(index)
#modfunc clear_stack
max = 0
return
#global
// 矩形の塗りつぶし
// http://rpen.blogspot.com/2007/11/blog-post.html
#include "gdi32.as"
#module
#const FLOODFILLSURFACE 1
#deffunc fill int x, int y
current_color = ginfo_r, ginfo_g, ginfo_b
CreateSolidBrush (ginfo_b << 16) | (ginfo_g << 8) | ginfo_r
if stat {
hBrush = stat
} else {
dialog "ブラシの生成に失敗しました。プログラムを終了します。", 1
end
}
SelectObject hDC, hBrush
pget x, y
ExtFloodFill hdc, x, y, (ginfo_b << 16) | (ginfo_g << 8) | ginfo_r, FLOODFILLSURFACE
DeleteObject hBrush
color current_color(0), current_color(1), current_color(2)
return
#global
// 命令を解析して描画するモジュール
#include "bregexp.hsp"
#module drawer
#define ctype result(%1) int(_result(%1))
#deffunc draw str _cmd
cmd = _cmd
BSplit _result, cmd, "m/[ ,]+/"
switch _result(0)
case "moveTo" : pos result(1), result(2) : swbreak
case "lineTo" : line result(1), result(2) : swbreak
case "color" : color result(1), result(2), result(3) : swbreak
case "fill" : fill result(1), result(2) : redraw 1 : swbreak
default : logmes "未知の命令です" : swbreak
swend
return
#deffunc draw_all array cmds, int wait_time
redraw 0
color 255, 255, 255 : boxf
color
repeat get_length(cmds)
draw get_at(cmds, cnt)
if wait_time {
redraw 1
wait wait_time
redraw 0
}
loop
redraw 1
return
#global
#define push_and_do(%1,%2) push %1, %2 : draw %2
#define WM_MOUSEMOVE $00000200
#define WM_LBUTTONDOWN $00000201
#define WM_LBUTTONUP $00000202
#define WM_RBUTTONDOWN $00000204
*init
title "左ドラッグで線を描画 / 右クリックで塗りつぶし"
oncmd gosub *onLButtonDown, WM_LBUTTONDOWN
oncmd gosub *onRButtonDown, WM_RBUTTONDOWN
oncmd gosub *onLButtonUp, WM_LBUTTONUP
oncmd gosub *onMouseMove, WM_MOUSEMOVE
objsize 80
button gosub "color change", *color_change
button gosub "redraw slowly", *all_draw_slowly
button gosub "clear", *clear
button gosub "undo", *undo
new_sstack cmds
stop
// 色の変更
*color_change
hsvcolor rnd(192), 255, 255
push_and_do cmds, "color " + ginfo_r + "," + ginfo_g + "," + ginfo_b
return
// 全消去
*clear
clear_stack cmds
draw_all cmds, 0
return
// アンドゥ
*undo
tmp = pop(cmds)
draw_all cmds, 0
return
// すべて描画
*all_draw
draw_all cmds, 0
return
// ゆっくりとすべて描画
*all_draw_slowly
oncmd 0
gosub *invalidate_buttons
draw_all cmds, 4
gosub *validate_buttons
oncmd 1
return
// 左ドラッグ開始
*onLButtonDown
dragging = 1
push_and_do cmds, "moveTo " + mousex + "," + mousey
return
// 左ドラッグ終了
*onLButtonUp
dragging = 0
return
// 左ドラッグ中
*onMouseMove
if dragging {
push_and_do cmds, "lineTo " + mousex + "," + mousey
}
return
// 右クリック
*onRButtonDown
if dragging == 0 {
push_and_do cmds, "fill " + mousex + "," + mousey
}
return
#include "obj.as"
*invalidate_buttons
repeat 4
objgray cnt, 0
loop
return
*validate_buttons
repeat 4
objgray cnt, 1
loop
return
2008年2月12日火曜日
アンドゥや再生ができるペイントツール
2008年2月9日土曜日
リストビューのソート
リストビューのアイテムをLVM_SORTITEMSEXメッセージを使ってソートします。ちょくとさんのコールバック関数DLL「hscallbk.dll」が必要です。
リストビューのモジュールとしてもそこそこ利用できるかもしれません。
エクスプローラのように、「ヘッダ部分をクリックすると並び変わる」ようにもできるでしょう。（参考：http://hsp.tv/play/pforum.php?mode=pastwch&num=2749）
LVM_SORTITEMSEXメッセージの日本語情報は意外と少ないので、気が向いたら開発Wikiにフィードバックします。// 参考資料：
// リストビューを作成してみる
// http://yokohama.cool.ne.jp/chokuto/urawaza/listview1.html
// Windows32 API Constance 検索
// http://hspnext.com/tool/hsptool04.htm
// MSDN - LVM_SORTITEMSEX
// http://msdn2.microsoft.com/ja-jp/library/bb761055(en-us).aspx
#module mod_listview
#include "hscallbk.as"
#uselib ""
#func sort_items "" int, int, int
#define LVM_SETITEM $00001006
#define LVM_INSERTITEM $00001007
#define LVM_INSERTCOLUMN $0000101B
#define LVM_SORTITEMSEX $00001051
#define LVM_GETITEMTEXTA $0000102D
#define LVS_REPORT $00000001
#define WS_EX_NOPARENTNOTIFY $00000004
#define WS_VISIBLE $10000000
#define WS_CHILD $40000000
#deffunc make_listview
if vartype(proc) != vartype("callback") : gosub *init
winobj "SysListView32", "ListView", WS_EX_NOPARENTNOTIFY, WS_VISIBLE | WS_CHILD | LVS_REPORT, -1, -1
return stat
*init
setcallbk proc, sort_items, *sort_flag
sdim name, 64, 2
dim lvcolumn, 8
dim lvitem, 6
lvcolumn.0 = 0x000F
lvcolumn.2 = 100
lvitem.0 = 0x0001
lvitem.6 = 64
return
#deffunc add_column int id_list, str column_name, int index
if(index < 0 | id_list < 0) {
logmes "パラメータが不正です。"
return -1
}
name = column_name
lvcolumn.3 = varptr(name)
sendmsg objinfo_hwnd(id_list), LVM_INSERTCOLUMN, index, varptr(lvcolumn)
return stat
#deffunc add_item int id_list, array item, int index
if(index < 0 | id_list < 0) {
logmes "パラメータが不正です。"
return -1
}
if vartype(item) != vartype("str") {
logmes "配列変数の型が不正です。文字列型の変数を渡してください。"
return -1
}
// アイテムの作成
lvitem.1 = index
lvitem.2 = 0
lvitem.5 = varptr(item)
sendmsg objinfo_hwnd(id_list), LVM_INSERTITEM, 0, varptr(lvitem)
// サブアイテムの作成
repeat length(item) - 1, 1
lvitem.2 = cnt
lvitem.5 = varptr(item(cnt))
sendmsg objinfo_hwnd(id_list), LVM_SETITEM, 0, varptr(lvitem)
loop
return stat
#deffunc sort int id_list, int column, int vtype, int sortmode
if(column < 0 | id_list < 0 | vtype < 0) {
logmes "パラメータが不正です。"
return -1
}
lvitem.2 = column
var_type = vtype
sendmsg objinfo_hwnd(id_list), LVM_SORTITEMSEX, sortmode, varptr(proc)
return
#defcfunc local compareAsInt int id_list, int index1, int index2, int sortmode
gosub *startCompare
return int(name(sortmode & 1)) - int(name((sortmode & 1) ^ 1))
#defcfunc local compareAsStr int id_list, int index1, int index2, int sortmode
gosub *startCompare
return name(sortmode & 1) ! name((sortmode & 1) ^ 1)
return
*startCompare
lvitem.5 = varptr(name(0))
sendmsg objinfo_hwnd(id_list), LVM_GETITEMTEXTA, index1, varptr(lvitem)
lvitem.5 = varptr(name(1))
sendmsg objinfo_hwnd(id_list), LVM_GETITEMTEXTA, index2, varptr(lvitem)
return
// サブアイテム（ファイルサイズ）でソート
// 第3引数が0なら昇順、1なら降順
*sort_flag
if var_type == vartype("int") {
return compareAsInt@mod_listview(id_list, callbkarg(0), callbkarg(1), callbkarg(2))
} else : if var_type == vartype("str") {
return compareAsStr@mod_listview(id_list, callbkarg(0), callbkarg(1), callbkarg(2))
}
return 0
#global // end of mod_listview
// 疑似的な「ファイル」の数
#define NUM_FILES 10
randomize
gosub *createGuiObjects
stop
// ボタンクリックによって呼び出されるサブルーチン
*sort_asc_by_name
sort id_list, 0, vartype("str"), 0
return
*sort_desc_by_name
sort id_list, 0, vartype("str"), 1
return
*sort_asc_by_size
sort id_list, 1, vartype("int"), 0
return
*sort_desc_by_size
sort id_list, 1, vartype("int"), 1
return
// ボタンとリストビューの作成
*createGuiObjects
// ボタンを作成
objsize ginfo_winx / 4, 32
pos 0, 0 : button gosub "ファイル名で昇順にソート", *sort_asc_by_name
pos ginfo_winx / 4, 0 : button gosub "ファイル名で降順にソート", *sort_desc_by_name
pos ginfo_winx / 2, 0 : button gosub "ファイルサイズで昇順にソート", *sort_asc_by_size
pos ginfo_winx * 3 / 4, 0 : button gosub "ファイルサイズで降順にソート", *sort_desc_by_size
// リストビューコントロール作成
pos 0, 32 : objsize ginfo_winx, ginfo_winy - 32
make_listview : id_list = stat
// カラムを追加
column_name = "ファイル名", "ファイルサイズ"
repeat 2
add_column id_list, column_name(cnt), cnt
if stat == -1 {
dialog "カラムの追加に失敗", 1
end
}
loop
// アイテム・サブアイテムの追加
sdim item_name, 64, 2
repeat NUM_FILES
item_name = "ファイル" + cnt, "" + rnd(1000) + " KB"
add_item id_list, item_name, cnt
if stat == -1 {
dialog "アイテムの追加に失敗", 1
end
}
loop
return
2008年1月5日土曜日
ツリービュー2
Fujiさんのブログにあるモジュール変数でツリーを利用したスクリプト。
このモジュールで作成したツリーを渡すことで、ツリービューを作成するモジュールです。
ツリー作成モジュールは上記ブログからの引用（一部削除）です。// 参考
// http://yokohama.cool.ne.jp/chokuto/urawaza/treeview1.html
// http://www.fujidig.com/2007/12/modvar-tree.html
#module m_tree children, content
#modfunc set_tree_content str _content
content = _content
return
#defcfunc getaptr@m_tree var p1, local hspctx, local vptr
mref hspctx, 68
dupptr vptr, hspctx.207, 8, 4
return vptr.1
#modinit str _content
set_tree_content thismod, _content
dimtype children, 5, 1
return getaptr( thismod )
#deffunc _new_tree array tree, str _content
#define global new_tree( %1, %2 = "" ) _new_tree %1,%2
newmod tree, m_tree, _content
return stat
#defcfunc get_tree_content modvar m_tree@
return content
#defcfunc get_tree_num_children modvar m_tree@
return length( children )
#modfunc get_tree_child int index, var result
if( index < 0 || index >= length( children ) ) : return 1
if( varuse( children.index ) == 0 ) : return 1
result = children.index
return 0
#modfunc add_tree_child var child
new_tree children
children.stat = child
return
#modfunc _show_tree str indent
#define global show_tree( %1, %2 = "" ) _show_tree %1, %2
mes indent + content
foreach children
if( varuse( children.cnt ) ) {
show_tree children.cnt, indent + " "
}
loop
return
#global
// ここまで引用
#include "user32.as"
#include "comctl32.as"
#module m_treeview h_treeview
#const TVIF_TEXT 0x00000001
#const TVI_LAST 0xFFFF0002
#const TVM_INSERTITEM 0x00001100
// ノードを再帰的に追加
#modfunc add_node@m_treeview var _node, int h_parent, local node, local h_node
node = _node : dim tvins, 12
bufText = get_tree_content(node)
tvins = h_parent, TVI_LAST, TVIF_TEXT
tvins(6) = varptr(bufText), strlen(bufText)
sendmsg h_treeview, TVM_INSERTITEM, 0, varptr(tvins)
h_node = stat
// 子ノードの追加
repeat get_tree_num_children(node)
get_tree_child node, cnt, child
if stat : continue
add_node@m_treeview thismod, child, h_node
loop
return h_node
// ツリービューの作成
// statにはツリービューのハンドルが返る
#define global make_treeview(%1, %2, %3, %4) newmod %1, m_treeview, %2, %3, %4
#modinit var root, int _width, int _height
// コモンコントロールライブラリ初期化（無くても動作する？）
initCCEx = 8, 0x00000002
InitCommonControlsEx varptr(initCCEx)
if stat == 0 : return -1
// コントロールの作成
style = 0x40000000 | 0x10000000 | 0x0001 | 0x0002 | 0x0200
CreateWindowEx 0, "SysTreeView32", "", style, ginfo_cx, ginfo_cy, _width, _height, hwnd, 0, 0, 0
h_treeview = stat
if h_treeview == 0 : return -1
add_node@m_treeview thismod, root, 0
return h_treeview
#global
// ツリーの作成（引用）
new_tree tree, "root"
new_tree tree_1, "1"
add_tree_child tree, tree_1
new_tree tree_2, "2"
add_tree_child tree, tree_2
new_tree tree_2_1, "2-1"
add_tree_child tree_2, tree_2_1
new_tree tree_2_1_1, "2-1-1"
add_tree_child tree_2_1, tree_2_1_1
new_tree tree_2_2, "2-2"
add_tree_child tree_2, tree_2_2
// ツリービューを作成
cls 1
make_treeview treeview, tree, 100, ginfo_winy
if stat == -1 {
dialog "ツリービューの作成に失敗しました。", 1
end
}
// ツリーを表示
pos 100, 0
show_tree tree
stop
2008年1月2日水曜日
lstrlenAとstrlenの速度比較
今回の条件ではlstrlenAよりもstrlenの方が高速な模様。
※別の書き方ではlstrlenAの方が速くなります。むしろそちらの書き方の方が普通と考えられます。m(_ _;)m// lstrlenAとstrlenの速度比較
#uselib "kernel32.dll"
#cfunc lstrlenA "lstrlenA" sptr
#uselib "winmm.dll"
#cfunc timeGetTime "timeGetTime"
#const trial_times 1000
font msgothic, 14
repeat 3, 1
trial_strlen = cnt * cnt * cnt * 1000
sdim trial_string, trial_strlen + 1
memset trial_string, 'a', trial_strlen
// lstrlenAの速度計測
time(0) = timeGetTime()
repeat trial_times
tmp = strlen(trial_string)
loop
time(0) = timeGetTime() - time(0)
// strlenの速度計測
time(1) = timeGetTime()
repeat trial_times
tmp = lstrlenA(trial_string)
loop
time(1) = timeGetTime() - time(1)
mes strf("文字列長（%dbytes）の場合：", trial_strlen)
mes strf(" strlen ：%d[msec]", time(0))
mes strf(" lstrlenA：%d[msec]", time(1))
mes ""
loop
stop
2007年12月28日金曜日
レジストリを読み出す（advapi32）
advapi32を利用したレジストリ読み出し。HSP3標準エディタの「起動時のカレントディレクトリ」を読み出します。
事前にデータの大きさを知ることができる分、hspextよりも便利かもしれません。
ここでは利用していませんが、エラーの原因を詳しく追及することもできます。// 参考（というか丸写し）
// ちょくとのページ：レジストリに保存してみる
// http://yokohama.cool.ne.jp/chokuto/urawaza/registry.html
#uselib "advapi32.dll"
#func global RegCloseKey "RegCloseKey" sptr
#func global RegOpenKeyExA "RegOpenKeyExA" sptr,sptr,sptr,sptr,sptr
#func global RegQueryValueExA "RegQueryValueExA" sptr,sptr,sptr,sptr,sptr,sptr
#const HKEY_CURRENT_USER 0x80000001
#const KEY_QUERY_VALUE 0x0001
// レジストリキーをオープン
name = "Software\\OnionSoftware\\hsed3"
RegOpenKeyExA HKEY_CURRENT_USER, name, 0, KEY_QUERY_VALUE, varptr(hkey)
if stat != 0 {
dialog "キーをオープンできません。", 1
end
}
// データのサイズを取得
RegQueryValueExA hkey, "startdir", 0, 0, 0, varptr(size)
if stat != 0 {
mes "データサイズを取得できませんでした。"
} else {
mes strf("データサイズは%dバイトです。", size)
// 文字列データを取得
sdim result, size
RegQueryValueExA hkey, "startdir", 0, 0, varptr(result), varptr(size)
if stat != 0 {
mes "データを取得できませんでした。"
} else {
mes result
}
}
// レジストリキーのハンドルをクローズ
RegCloseKey hkey
stop
2007年11月11日日曜日
閉塞領域の塗りつぶし
ペイントツールお約束の機能も、APIを使えば簡単に実装できます。
昔はSRPGの経路探索を応用したりしてモジュールを組んでたのですが……今思えば結構無茶してますね。
なおHSP2.61用のスクリプトはCrimson Forestさんにあるようです。// 参考
// http://msdn.microsoft.com/library/ja/default.asp?url=/library/ja/jpgdi/html/_win32_extfloodfill.asp
#include "gdi32.as"
#module
#const FLOODFILLSURFACE 1
// カレントカラーで（x, y）を含む同色領域を塗りつぶす
// 実際の画面に反映させるには redraw 1 を実行すること
#deffunc fill int x, int y
// カレントカラーを記憶
current_color = ginfo_r, ginfo_g, ginfo_b
// カレントカラーからブラシを生成
CreateSolidBrush (ginfo_b << 16) | (ginfo_g << 8) | ginfo_r
if stat {
hBrush = stat
} else {
dialog "ブラシの生成に失敗しました。プログラムを終了します。", 1
end
}
SelectObject hDC, hBrush
// 塗りつぶす色を取得
pget x, y
// 塗りつぶし実行
ExtFloodFill hdc, x, y, (ginfo_b << 16) | (ginfo_g << 8) | ginfo_r, FLOODFILLSURFACE
// 後始末
DeleteObject hBrush
color current_color(0), current_color(1), current_color(2)
return
#global
repeat 5
hsvcolor 191 * cnt / 5, 255, 255
boxf rnd(640), rnd(480), rnd(640), rnd(480)
loop
onclick gosub *do_fill
stop
*do_fill
hsvcolor rnd(192), 255, 255
fill mousex, mousey
redraw 1
return
2007年9月11日火曜日
かんたん付箋ツール
sprocketさんのサイトで、SQLite3を簡単に扱えるモジュールSQLeleが公開されました。データの保存・読み込みに費やしていた労力を大幅に削減することができるので、特にツール開発者の方々には重宝すると思います。
……ということで、初SQLele。1行だけの簡単な付箋を作成します。プライマリ・キーが1から始まることを利用し、ウィンドウIDを兼ねさせています。
CREATE TABLE実行時、主キー以外においてデータ型の宣言をしないように変更しました。（2007/09/19）
参考
- 日経ソフトウェア2007年10月号特集「データベース徹底入門」
- タイトルバー以外をドラッグして移動
// かんたん付箋ツール on SQLele
#uselib "user32.dll"
#func global ReleaseCapture "ReleaseCapture"
#include "sqlele.hsp"
#define FILENAME_DB "tags.db"
#define WM_NCLBUTTONDOWN 0xA1
#define WM_MOVE 0x03
#define HTCAPTION 0x02
// 変数・DBの初期化
new_memo = ""
sql_open FILENAME_DB
sql_q "CREATE TABLE IF NOT EXISTS TAGS ( ID INTEGER PRIMARY KEY, MEMO, X, Y)"
// メインウィンドウを作成
syscolor 15 : boxf : syscolor 18
mes "文章："
pos ginfo_mesx, 0 : input new_memo, ginfo_winx - ginfo_cx, , 254
pos 0 : mes {"文字列を入力してEnter で 付箋の作成
左ドラッグ で 付箋の移動
右クリック で 付箋の廃棄"}
// on系命令の準備
onkey gosub *onkey_flag
onclick gosub *click_flag
onexit goto *exit_flag
// すべての付箋を作成する
gosub *make_all_tags
stop
// Enterキー判定用
*onkey_flag
if ( wparam == 13 ) : gosub *make_new_tag
return
// 新しい付箋の情報をDBに追加(INSERT)
*make_new_tag
if ( strlen( new_memo ) > 0 ) {
sql_q "INSERT INTO TAGS ( MEMO, X, Y ) VALUES ( '" + new_memo + "', 0, 0 )"
gosub *make_all_tags // すべての付箋を作り直す（ちょっとムダな処理）
}
return
// すべてのタグを作り直す
*make_all_tags
sql_q "SELECT * FROM TAGS"
repeat stat
gsel 0 : pos ginfo_winx : mes sql_v( "MEMO" )
bgscr int( sql_v( "ID" ) ), ginfo_mesx, ginfo_mesy, 0, int( sql_v( "X" ) ), int( sql_v( "Y" ) )
oncmd gosub *move_flag, WM_MOVE
mes sql_v( "MEMO" )
sql_next
loop
return
// 付箋が移動したので、データベースを更新(UPDATE)する
*move_flag
gsel ginfo_act
sql_q "UPDATE TAGS SET X = " + ginfo_wx1 + " WHERE ID = " + ginfo_act
sql_q "UPDATE TAGS SET Y = " + ginfo_wy1 + " WHERE ID = " + ginfo_act
return
// 付箋がクリックされたので、何らかの操作を施す
*click_flag
if ( iparam == 0 ) {
// 左クリック → ドラッグ開始
ReleaseCapture
gsel ginfo_act
sendmsg hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
} else : if ( iparam == 3 ) {
// 右クリック → 付箋の廃棄
sql_q "DELETE FROM TAGS WHERE ID = " + ginfo_act
gsel ginfo_act, -1 // とりあえず非表示にする
}
return
// アプリケーション終了時、データベースをクローズ
*exit_flag
sql_close
end
タイトルバー以外をドラッグして移動
HSP2向けのスクリプトはおくださんのサイトや旧チキチキチキニータさんにあったのですが、HSP3向けのスクリプトがないようなので書いてみました。検索ワード変えたらかなりヒットしました。さくらさんのサイトや開発Wikiにもありましたね、灯台もと暗しとはこのことです。まぁこの投稿は次の投稿への布石なので、残しておきます……^^;
早い話が「クライアント領域をクリックしたときに、タイトルバーをクリックした事にしちゃう」わけです。// 参考・http://www.microsoft.com/japan/msdn/vbasic/migration/tips/Movement/
#include "user32.as"
#define WM_NCLBUTTONDOWN 0xA1
#define HTCAPTION 0x02
onclick gosub *click
stop
*click
ReleaseCapture
; gsel ginfo_act // ウィンドウが複数ある場合に必要
sendmsg hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
return
2007年9月6日木曜日
RADツールサンプル（失敗作）
先日の「ドラッグできる矩形の表示」をちょっと改造して、ドラッグできるメッセージボックス・ボタン・チェックボックスを作成。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
