2007年9月21日金曜日

動的SQLによる数独の超高速解法(by CodeZine)

SQLele利用スクリプト第4弾。
みんな大好きCodeZine様より転載しました。元記事は動的SQLによる数独の超高速解法。よって今回の記事を利用する場合はCodeZine様の規約に従ってください。
元記事の章・節に合わせたコメントが付いています。

……しかしこれはすごいですね。
SQLで数独を解くという発想もさることながら、その速度が充分実用的な点に驚かされます。
解法が複数ある場合でもすべて示してくれるのも素晴らしいです。

WHERE節の条件重複を回避するためにxnoteaddを利用しようとしたのですが、原因不明のエラーで落ちてしまうので独自命令で対応しています。生成されるSQL文を元記事と全く同じにするためにはWHERE節のソートも必要だったのですが、sortnoteの仕様(空行追加)がややこしかったので考慮していません。
// http://codezine.jp/a/article/aid/1629.aspx
// 動的SQLによる数独の超高速解法
#runtime "hsp3cl" 
#include "sqlele.hsp"
#module
// 文字列の置換(参考:サンプルスクリプトcompbj/comtest9.hsp)
#deffunc replace var target, str before, str after
    newcom o_reg, "VBScript.RegExp"
    comres target
    o_reg( "Pattern" ) = before         // 検索パターンの設定
    o_reg( "Global" ) = 1               // すべて置換する
    o_reg -> "Replace" target, after    // 検索の実行
    delcom o_reg
    return
// xnoteadd代替命令(今回は問題ないが、完全互換ではない点に注意)
#deffunc xnoteadd_ var target, str add
    if instr( target, 0, add + "\n" ) < 0 {
        target += add + "\n"
    }
    return
#global
    dim problem, 99
    problem(00) = 1,0,0,0,0,7,0,9,0
    problem(01) = 0,3,0,0,2,0,0,0,8
    problem(02) = 0,0,9,6,0,0,5,0,0
    problem(03) = 0,0,5,3,0,0,9,0,0
    problem(04) = 0,1,0,0,8,0,0,0,2
    problem(05) = 6,0,0,0,0,4,0,0,0
    problem(06) = 3,0,0,0,0,0,0,1,0
    problem(07) = 0,4,0,0,0,0,0,0,7
    problem(08) = 0,0,7,0,0,0,3,0,0
    max_num = length( problem )
    m = intsqrtlength( problem ) ) )

    sdim select_items, 6400
    sdim from_items, 6400
    sdim where_items, 30000

    // SELECT文の生成
    for row1, 0, max_num
        for col1, 0, max_num
            label1 = "R" + ( row1 + 1 ) + "C" + ( col1 + 1 )
            // SELECT節
            if problem( col1, row1 ) != 0 {
                item1 = str( problem( col1, row1 ) )
            } else {
                item1 = "t" + label1 + ".n"
            }
            select_items += item1 + " AS " + label1 + ","
            // FROM節
            if problem( col1, row1 ) == 0 {
                from_items += "nums t" + label1 + ","
            }
            // WHERE節
            for row2, 0, max_num
                for col2, 0, max_num
                    if ( problem( col1, row1 ) == 0 ) | ( problem( col2, row2 ) == 0 ) {
                        if (( row1 == row2 ) & ( col1 != col2 )) | (( row1 != row2 ) & ( col1 == col2 )) | (( row1 != row2 ) & ( col1 != col2 ) & ( row1 / m == row2 / m ) & ( col1 / m == col2 / m )) {
                            label2 = "R" + ( row2 + 1 ) + "C" + ( col2 + 1 )
                            if problem( col2, row2 ) != 0 {
                                item2 = str( problem( col2, row2 ) )
                            } else {
                                item2 = "t" + label2 + ".n"
                            }
                            if ( item1 != item2 ) < 0 {
                                xnoteadd_ where_items, item1 + "!=" + item2
                            } else {
                                xnoteadd_ where_items, item2 + "!=" + item1
                            }
                        }
                    }
                next
            next
        next
    next
    // SELECTの完成
    sdim sql, 30000
    poke select_items, strlen( select_items ) - strlen"," ), 0        // 最後の余計なカンマを削除
    poke from_items, strlen( from_items ) - strlen"," ), 0            // 最後の余計なカンマを削除
    replace where_items, "\\n"" AND "                                 // 改行を削除
    poke where_items, strlen( where_items ) - strlen" AND " ), 0      // 最後の余計なANDを削除
    sql = "SELECT " + select_items + " FROM " + from_items + " WHERE " + where_items
;   notesel sql : notesave "sql.txt"

// クエリの実行
    // テーブル:numsの準備
    sql_open ":memory:"
    sql_q "CREATE TABLE nums (n INTEGER NOT NULL PRIMARY KEY);"
    repeat 91
        sql_q "INSERT INTO nums VALUES (" + prm_i(cnt) + ");"
    loop
    // 結果の取得
    sql_q sql
    repeat stat1
        mes "Solution No." + cnt
        for r, 0, max_num
            s = ""
            for c, 0, max_num
                s += strf("%1d "sql_i"R" + ( r + 1 ) + "C" + ( c + 1 ) ) )
            next
            mes s
        next
        sql_next
    loop

    sql_close
    stop

2007年9月19日水曜日

ファイルの情報を規則に従ってソート

SQLele利用スクリプト第3弾。
今まで書きためたスクリプト(拡張子.hspのファイル)の一覧を作成し、「更新年月日ランキング」「サイズランキング」「ファイル名の長さランキング」を決定します。今までの蓄積が分かって面白いかもしれません。

ファイルの検索にdirlist2を、データベースの作成にcsvstrを利用しています。
場合によってはdirlist2で得た結果をそのままINSERT 文に渡しても良いでしょう。

SQL文はソートをORDER BYで指定することと、昇順はASC,降順はDESCで指定することさえ理解できれば特に難しいことはしていません。また、LIMITを指定することで特定数のファイルのみを取得しています。

フルパスじゃないのにカラム名をFULLPATHとしていた点を修正。(2007/09/20)
SQLele1.1リリースに合わせ、ファイル名の長さを「bytes」から「文字」に変更。(2007/09/29)

#include "sqlele.hsp"
#include "hspext.as"
#include "hspda.as"
#const RANKING_NUM  5                   // ランキングのTOPいくつまでを表示するか?

// 検索するフォルダを取得し、カレントディレクトリとする
    sdim target_folder, 1024
    selfolder target_folder, ""
    chdir target_folder

// カレントディレクトリ以下にあるファイルをdirlist2で検索
// ファイルのフルパス・サイズ・更新日付を取得する
// カンマ区切りで記録されるため、csvstr命令で分解することが可能
    dirlist2h %1101
    dirlist2 var_size, "*.hsp"%01    // サブディレクトリも検索
    if ( stat < RANKING_NUM ) {
        // ファイルが少なすぎる
        dialog "ファイルが少なすぎます。"1
        end
    }
    title strstat ) + "個のファイルが見つかりました。"
    sdim files, var_size + 1
    dirlist2r files

// メモリ上にデータベース作成
// 必要ないので、主キーは作成しない
    sql_open ":memory:"
    sql_q "CREATE TABLE FILES (PATH,FILENAME,FILESIZE,TIMESTAMP)"
    notesel files                       // 先ほどの検索結果をメモリノートパッド命令のバッファに設定
    sdim tmp_line, 1024                 // メモリノートパッドから取り出した行を格納する変数
    sdim tmp_cells, 2563              // 行を変換(分解)した結果を格納する配列変数

    sql_q "BEGIN"                       // トランザクションの開始
    repeat notemax
        noteget tmp_line, cnt               // 1行ずつ取り出す(getstrを使えば、より高速化可能)
        csvstr tmp_cells, tmp_line          // 取り出した行を配列に変換
        file_name = getpath( tmp_cells( 0 ), 8 )
        sql_q "INSERT INTO FILES VALUES (" + prm_text(tmp_cells(0)) + ", " + prm_text(file_name) + ", " + prm_i(int(tmp_cells(1))) + ", " + prm_text(tmp_cells(2)) + ")"
    loop
    sql_q "COMMIT"                      // トランザクションの終了

// ランキングの集計
// SELECT 文の ORDER BY を利用することによって実現
// サブルーチンなどでよりスマートにできるはず……。
    result = ""                         // 結果を格納する変数

    // ファイルサイズランキング(大きい順)
    sql_q "SELECT PATH,FILESIZE FROM FILES ORDER BY FILESIZE DESC LIMIT " + RANKING_NUM
    repeat RANKING_NUM1
        result += strcnt ) + "番目に大きいファイルは" + sql_v"PATH" ) + "(" + sql_v"FILESIZE" ) + "bytes)です。\n"
        sql_next
    loop
    result += "----\n"

    // ファイルサイズランキング(小さい順)
    sql_q "SELECT PATH,FILESIZE FROM FILES ORDER BY FILESIZE ASC LIMIT " + RANKING_NUM
    repeat RANKING_NUM1
        result += strcnt ) + "番目に小さいファイルは" + sql_v"PATH" ) + "(" + sql_v"FILESIZE" ) + "bytes)です。\n"
        sql_next
    loop
    result += "----\n"

    // 更新年月日ランキング(新しい順)
    sql_q "SELECT PATH,TIMESTAMP FROM FILES ORDER BY TIMESTAMP DESC LIMIT " + RANKING_NUM
    repeat RANKING_NUM1
        result += strcnt ) + "番目に新しいファイルは" + sql_v"PATH" ) + "(" + sql_v"TIMESTAMP" ) + ")です。\n"
        sql_next
    loop
    result += "----\n"

    // 更新年月日ランキング(古い順)
    sql_q "SELECT PATH,TIMESTAMP FROM FILES ORDER BY TIMESTAMP ASC LIMIT " + RANKING_NUM
    repeat RANKING_NUM1
        result += strcnt ) + "番目に古いファイルは" + sql_v"PATH" ) + "(" + sql_v"TIMESTAMP" ) + ")です。\n"
        sql_next
    loop
    result += "----\n"

    // ファイル名の長さランキング(長い順)
    sql_q "SELECT PATH,length(FILENAME) AS LENGTH FROM FILES ORDER BY LENGTH DESC LIMIT " + RANKING_NUM
    repeat RANKING_NUM1
        result += strcnt ) + "番目に名前の長いファイルは" + sql_v"PATH" ) + "(" + sql_v"LENGTH" ) + "文字)です。\n"
        sql_next
    loop
    result += "----\n"

    // ファイル名の長さランキング(短い順)
    sql_q "SELECT PATH,length(FILENAME) AS LENGTH FROM FILES ORDER BY LENGTH ASC LIMIT " + RANKING_NUM
    repeat RANKING_NUM1
        result += strcnt ) + "番目に名前の短いファイルは" + sql_v"PATH" ) + "(" + sql_v"LENGTH" ) + "文字)です。\n"
        sql_next
    loop

// データベースを閉じ、結果を表示
    sql_close
    mesbox result, ginfo_winxginfo_winy4
    stop

2007年9月12日水曜日

フォルダ内のファイルをひとつのファイルにまとめて戻す

SQLele利用スクリプト第2弾。
フォルダ内のファイルをひとつのDBファイルにまとめて戻します。複数データの圧縮や暗号化前の処理として大いに活用できそうです。フォルダ名をDBファイル名に記録している点は、あまりDBっぽくはないですが……。
※まとめたDBファイルや戻したフォルダはデスクトップに保存されます。

早い話がBLOBを利用して、DB内にファイル名とその内容を記録しているだけです。よってタイムスタンプなどは保存されていません。
サブフォルダ内のファイルは対象としていませんが、複数のテーブルをDB内に保持することで実装可能でしょう。
// フォルダ内のファイルをひとつのファイル(.db)にまとめる
// サブディレクトリ内は対象外
#include "hspext.as"
#include "sqlele.hsp"

    // まとめるフォルダを選択
    target_dir = ""
    selfolder target_dir, "まとめるフォルダを選んでください"
    if ( stat == 1 ) : end

    db_name = getpath( target_dir, 11 ) + ".db"   // DBファイルの名前(= フォルダ名 + ".db")
    chdir dir_desktop                             // DBファイルの保存先はデスクトップに固定

    // もしDBファイルがあったら削除する(SQL文でテーブルを消去しても良い)
    exist db_name
    if ( strsize >= 0 ) : delete db_name

    // sqlを開いてテーブルを作成
    sql_open db_name
    sql_q "CREATE TABLE FILES (FILENAME TINYTEXT PRIMARY KEY, DATA)"

    // ファイルをひとつずつデータベースに格納
    chdir target_dir
    notesel files
    dirlist files, "*"1
    num_files = stat
    sql_q "BEGIN"
    repeat num_files
        noteget file_name, cnt
        exist file_name : file_size = strsize
        sdim file_data, file_size
        bload file_name, file_data, file_size
        sql_q "INSERT INTO FILES (FILENAME, DATA) VALUES ('" + file_name + "', " + prm_blob( file_data, file_size ) + ")"
    loop
    sql_q "COMMIT"
    sql_close
    end


そしてこれが復元用スクリプト。
// ひとつのファイルにまとめたフォルダを戻す
#include "sqlele.hsp"

    // DBファイルを指定
    dialog "db"16"フォルダをまとめたデータベース"
    if ( stat == 0 ) : end
    db_name = refstr                    // DBファイルの名前(フルパス)
    dir_name = getpath( db_name, 9 )    // ディレクトリの名前

    // デスクトップに作ろうとしてるフォルダと同じ名前のフォルダがある場合、処理を中断(上書き防止)
    chdir dir_desktop
    dirlist tmp, dir_name, 5
    if ( stat > 0 ) {
        dialog "既に同じ名前のフォルダが存在します。"1
        end
    }

    // DBを開き、ファイルをひとつずつ復元
    sql_open db_name
    mkdir dir_name : chdir dir_name
    sql_q "SELECT * FROM FILES"
    repeat stat
        file_size = sql_blobsize"DATA" )
        sdim file_data, file_size
        sql_blobcopy file_data, "DATA"
        bsave sql_v"FILENAME" ), file_data, file_size
        sql_next
    loop
    sql_close
    end

2007年9月11日火曜日

かんたん付箋ツール

sprocketさんのサイトで、SQLite3を簡単に扱えるモジュールSQLeleが公開されました。データの保存・読み込みに費やしていた労力を大幅に削減することができるので、特にツール開発者の方々には重宝すると思います。

……ということで、初SQLele。1行だけの簡単な付箋を作成します。プライマリ・キーが1から始まることを利用し、ウィンドウIDを兼ねさせています。

CREATE TABLE実行時、主キー以外においてデータ型の宣言をしないように変更しました。(2007/09/19)
参考


// かんたん付箋ツール 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_mesx0 : 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 intsql_v"ID" ) ), ginfo_mesxginfo_mesy0intsql_v"X" ) ), intsql_v"Y" ) )
        oncmd gosub *move_flagWM_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 hwndWM_NCLBUTTONDOWNHTCAPTION0
    } 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 hwndWM_NCLBUTTONDOWNHTCAPTION0
    return

2007年9月9日日曜日

HSPスクリプトビューワ(Footy2)

Footy2とHHXモジュールによるスクリプトビューワ。機能は読み込みのみで、保存さえできません(^-^;

私がプログラミングを始めたころはリッチテキストを扱うなんてまさに雲の上のお話だったのですが、なべしんさんのおかげでとても簡単になりました。ちょっと信じ難いくらいお手軽です。

それとヘッダファイルFooty2.asを作成したので、なべしんさんの許可が降りたら公開したいと思います。
#include "../hsphelp/src/hhx_db.hsp"
#uselib "Footy2.dll"
#func Footy2Create "Footy2Create" int, int, int, int, int, int
#func Footy2Delete "Footy2Delete" int
#func Footy2TextFromFile "Footy2TextFromFileA" int, sptr, int
#func Footy2AddEmphasis "Footy2AddEmphasisA" int, sptr, sptr, int, int, int, int, int, int
#func Footy2FlushEmphasis "Footy2FlushEmphasis" int
// 独立レベル
/*ASCII記号用フラグ*/
#define global EMP_IND_PARENTHESIS 0x00000001//!< 前後に丸括弧()があることを許可する
#define global EMP_IND_BRACE 0x00000002//!< 前後に中括弧{}があることを許可する
#define global EMP_IND_ANGLE_BRACKET 0x00000004//!< 前後に山形括弧<>があることを許可する
#define global EMP_IND_SQUARE_BRACKET 0x00000008//!< 前後に各括弧[]があることを許可する
#define global EMP_IND_QUOTATION 0x00000010//!< 前後にコーテーション'"があることを許可する
#define global EMP_IND_UNDERBAR 0x00000020//!< 前後にアンダーバー_があることを許可する
#define global EMP_IND_OPERATORS 0x00000040//!< 前後に演算子 + - * / % ^  があることを許可する
#define global EMP_IND_OTHER_ASCII_SIGN 0x00000080//!< 前述のものを除く全てのASCII記号 # ! $ & | \ @ ?  .
/*ASCII文字列を指定するフラグ*/
#define global EMP_IND_NUMBER 0x00000100//!< 前後に数字を許可する
#define global EMP_IND_CAPITAL_ALPHABET 0x00000200//!< 前後に大文字アルファベットを許可する
#define global EMP_IND_SMALL_ALPHABET 0x00000400//!< 前後に小文字アルファベットを許可する
/*空白を指定するフラグ*/
#define global EMP_IND_SPACE 0x00001000//!< 前後に半角スペースを許可する
#define global EMP_IND_FULL_SPACE 0x00002000//!< 前後に全角スペースを許可する
#define global EMP_IND_TAB 0x00004000//!< 前後にタブを許可する
/*そのほかの文字列*/
#define global EMP_IND_JAPANESE 0x00010000//!< 日本語
#define global EMP_IND_KOREAN 0x00020000//!< 韓国語
#define global EMP_IND_EASTUROPE 0x00040000//!< 東ヨーロッパ
#define global EMP_IND_OTHERS 0x80000000//!< 上記以外
/*省略形(主にこれらを使用すると指定が楽です)*/
#define global EMP_IND_ASCII_SIGN 0x000000FF//!< 全てのASCII記号列を許可する
#define global EMP_IND_ASCII_LETTER 0x00000F00//!< 全てのASCII文字を許可する(数字とアルファベット)
#define global EMP_IND_BLANKS 0x0000F000//!< 全ての空白文字列を許可する
#define global EMP_IND_OTHER_CHARSETS 0xFFFF0000//!< 全てのキャラクタセットを許可する
#define global EMP_IND_ALLOW_ALL 0xFFFFFFFF//!< 何でもOK

// キャラクタセット
#enum global CSM_AUTOMATIC = 0

// ビュー状態
#enum global VIEWMODE_NORMAL = 0

#enum global EMP_INVALIDITY = 0//!< 無効
#enum global EMP_WORD//!< 単語を強調
#enum global EMP_LINE_AFTER//!< それ以降~行末
#enum global EMP_LINE_BETWEEN//!< 二つの文字の間(同一行に限る・二つの文字列を指定)
#enum global EMP_MULTI_BETWEEN//!< 二つの文字の間(複数行にわたる・二つの文字列を指定)

// 強調表示モード
#define global EMPFLAG_BOLD   0x00000001//!< 太字にする
#define global EMPFLAG_NON_CS 0x00000002//!< 大文字と小文字を区別しない
#define global EMPFLAG_HEAD   0x00000004//!< 頭にあるときのみ

// エラー
#define global FOOTY2ERR_NONE           0   //!< 関数が成功した
#define global FOOTY2ERR_ARGUMENT       -1  //!< 引数おかしい
#define global FOOTY2ERR_NOID           -2  //!< IDが見つからない
#define global FOOTY2ERR_MEMORY         -3  //!< メモリー不足
#define global FOOTY2ERR_NOUNDO         -4  //!< アンドゥ情報がこれ以前に見つからない
#define global FOOTY2ERR_NOTSELECTED    -5  //!< 選択されていない
#define global FOOTY2ERR_UNKNOWN        -6  //!< 不明なエラー
#define global FOOTY2ERR_NOTYET         -7  //!< 未実装(ごめんなさい)
#define global FOOTY2ERR_404            -8  //!< ファイルが見つからない、検索文字列が見つからない
#define global FOOTY2ERR_NOTACTIVE      -9  //!< アクティブなビューは存在しません
#define global FOOTY2ERR_ENCODER        -10 //!< 文字コードのエンコーダが見つかりません(ファイルのエンコード形式が不正です、バイナリとか)
#define global FOOTY2ERR_NOT_SELECTING  -11 //!< 選択していない

#define COLOR_COMMENT 0xcccccc
#define COLOR_COMMAND 0xcc00cc
#define COLOR_FUNC 0xffff00
#define COLOR_PREPROCESS 0xffcc00
#define COLOR_LABEL 0xffff00
#define COLOR_SYSVAR 0xcc9900
#define COLOR_MACRO 0xcc9900
#define COLOR_STRING 0x00ccff
    title "Footytest"
    Footy2Create hwnd00ginfo_winxginfo_winyVIEWMODE_NORMAL
    if ( stat != FOOTY2ERR_NONE ) : end
    idFooty = stat

    // ファイルを読み込む
    dialog "hsp"16
    if ( stat == 0 ) : end
    fileName = refstr
    Footy2TextFromFile idFooty, fileName, CSM_AUTOMATIC
    if ( stat != FOOTY2ERR_NONE ) : end

    // hsphelpディレクトリの存在を確認
    chdir dir_exe
    dirlist s, "hsphelp"5 
    if ( stat == 0 ) : dialog "hsphelpディレクトリが見つかりません。"1 : end
    chdir dir_exe + "/hsphelp"

    // HHXのデータベースをロード
    HHX_init_load_db
    if HHX_currentset_sum() ! HHX_diskset_sum() {
        // HSファイルに何かしらの変更が加わったため、データベースを再構築
        logmes "HHXのデータベースをリビルドしています..."
        HHX_init_rebuild_db DBR_READONLY
    } else {
        HHX_init_extract_db             // 配列変数hhxdataxにメモリ上のデータをロード
    }
    logmes "HHXのデータベースをロードしました。"

    // データベースから命令・関数をひとつずつ取り出し、その名前を列挙する
    db_num = HHX_select_all()           // すべての命令・関数などを検索対象とする(ABC順)
    sdim buf, 16000
    notesel buf
    repeat db_num
        c = HHX_get_next()              // 次の命令・関数などのナンバーを取得
        db_name  = hhxdata( c, C_NAME )
        db_group = hhxdata( c, C_GROUP )
        db_prm   = hhxdata( c, C_PRM )
        if instr( db_group, 0"プリプロセッサ命令" ) >= 0 {
            ; プリプロセッサ
            Footy2AddEmphasis idFooty, db_name, 0EMP_WORD011EMP_IND_BLANKSCOLOR_PREPROCESS
        } else : if instr( db_group, 0"システム変数" ) >= 0 {
            ; システム変数
            Footy2AddEmphasis idFooty, db_name, 0EMP_WORD011EMP_IND_BLANKS | EMP_IND_PARENTHESIS | EMP_IND_OTHER_ASCII_SIGNCOLOR_SYSVAR
        } else : if instr( db_group, 0"マクロ" ) >= 0 {
            ; マクロ
            Footy2AddEmphasis idFooty, db_name, 0EMP_WORD011EMP_IND_BLANKS | EMP_IND_PARENTHESIS | EMP_IND_OTHER_ASCII_SIGNCOLOR_MACRO
        } else : if db_prm = "" {
            ; 引数なし(命令)
            Footy2AddEmphasis idFooty, db_name, 0EMP_WORD011EMP_IND_BLANKSCOLOR_COMMAND
        } else : if peek( db_prm ) = '(' {
            ; 関数型
            Footy2AddEmphasis idFooty, db_name, 0EMP_WORD011EMP_IND_BLANKS | EMP_IND_PARENTHESISCOLOR_FUNC
        } else {
            ; 命令型
            Footy2AddEmphasis idFooty, db_name, 0EMP_WORD011EMP_IND_BLANKSCOLOR_COMMAND
        }
    loop
    // そのほかの色分け
    Footy2AddEmphasis idFooty, "/*""*/"EMP_MULTI_BETWEEN011EMP_IND_ALLOW_ALLCOLOR_COMMENT
    Footy2AddEmphasis idFooty, ";"0EMP_LINE_AFTER011EMP_IND_ALLOW_ALLCOLOR_COMMENT
    Footy2AddEmphasis idFooty, "//"0EMP_LINE_AFTER011EMP_IND_ALLOW_ALLCOLOR_COMMENT
    Footy2AddEmphasis idFooty, "*"0EMP_LINE_AFTEREMPFLAG_HEAD11EMP_IND_ALLOW_ALLCOLOR_LABEL
    Footy2AddEmphasis idFooty, "{\"""\"}"EMP_MULTI_BETWEEN02, -1EMP_IND_ALLOW_ALLCOLOR_STRING

    // 色分けを反映
    Footy2FlushEmphasis idFooty

    onexit *exit
    stop
*exit
    Footy2Delete FootyID
    end

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 ), mousexmousey
        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 = GetDChwnd )
    gsel source_id
    source_hdc = GetDChwnd )
    BitBlt target_hdc, 00ginfo_winxginfo_winy, source_hdc, 00SRCCOPY
    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 1ginfo_winxginfo_winy, SCREEN_NORMAL, ginfo_wx1ginfo_wy1
    // オブジェクトの配置
    repeat 5
        w = rnd100 ) + 100 : h = rnd100 ) +  50
        x = rndginfo_winx - w ) : y = rndginfo_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 02       // ID1のスクリーンを隠すために最前面へ表示
    oncmd gosub *LButtonDownWM_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, -12LoadCursor( cursor_type )
    mouse       // マウスカーソルの更新(これがないと即座に反映されない)
    return
//
// ダミーラベル(ボタン用)
*dummy
    stop