2008年1月28日月曜日

サイトのサムネイルを表示する

サイトのサムネイルを作成・表示するAPI「ThumbnailAPI」を利用します。
ネットの接続などはスクリプトから明示的には行っていません。imgload命令の内部で使用しているCOMが自動で行ってくれているようです。
#include "mod_img.as"
    imgload "http://img.simpleapi.net/small/http://www.forest.impress.co.jp/"
    stop

2008年1月24日木曜日

複数行文字列の行数を取得する(2)

FUJIさんのご指摘を受けて、HSP標準のnotemaxとほぼ同等の動作をするモジュール。

参考:複数行文字列の行数を取得する

// 行数取得モジュール
// 変数の型チェックは行っていないので注意
#module
// instr()を利用した行数の取得
#defcfunc get_lines_num1 var p1
    result = 0
    repeat strlen(p1)
        result++
        ins = instr(p1, cnt"\n")
        if ins == -1 : break
        continue cnt + ins + 2
    loop
    return result
// 正規表現を利用した行数の取得
#defcfunc get_lines_num2 var p1
    if vartype(com_regexp) != vartype("comobj") {
        // comオブジェクト型変数の初期化
        newcom com_regexp, "VBScript.RegExp"
        comres com_result
        com_regexp("Pattern") = "\\r\\n"
        com_regexp("Global") = 1
    }
    com_regexp->"Execute" p1
    result = com_result("Count") + 1    // 行数 = 改行の個数 + 1
    s = strmid(p1, -12)
    if s == "\n" | s == "" : result--   // 最後が空行ならその行をカウントしない
    return result
// notemaxを利用した行数の取得
#defcfunc get_lines_num3 var p1
    notesel p1
    result = notemax
    noteunsel
    return result
#global
    sdim s, 323
    s(0) = "Hot\nSoup\nProcessor"
    s(1) = "sample\nstrings\n"
    s(2) = ""
    foreach s
        mes get_lines_num1(s(cnt))
        mes get_lines_num2(s(cnt))
        mes get_lines_num3(s(cnt))
        mes "***"
    loop
    stop

2008年1月23日水曜日

複数行文字列の行数を取得する

notemaxのように複数行文字列の行数を取得します。
正規表現版はパターンを"(\\r\\n)+"に変更することで、空行を無視するようにもできます。
#module
// instr()を利用した行数の取得
#defcfunc get_lines_num var p1
    result = 0
    repeat
        result++
        ins = instr(p1, cnt"\n")
        if ins == -1 : break
        continue cnt + ins + 2
    loop
    return result
// 正規表現を利用した行数の取得
#defcfunc get_lines_num2 var p1
    if vartype(com_regexp) != vartype("comobj") {
        // comオブジェクト型変数の初期化
        newcom com_regexp, "VBScript.RegExp"
        comres com_result
        com_regexp("Pattern") = "\\r\\n"
        com_regexp("Global") = 1
    }
    com_regexp->"Execute" p1
    return com_result("Count") + 1      // 行数 = 改行の個数 + 1
#global

    s = "Hot\nSoup\nProcessor\n\n"
    mes get_lines_num(s)
    mes get_lines_num2(s)
    stop

2008年1月17日木曜日

「ふっかつのじゅもん」っぽい暗号

昔のゲームに出てきそうなひらがな(64種)による暗号です。
ひらがな1文字(16ビット)で6ビットの情報が表現できますので、情報量は16/6=約2.7倍になります。妙にビット演算が多いので、単純な目的の割に複雑なスクリプトになっています。

カタカナも取り入れれば7ビットの情報が表現できるはずです。また、半角カタカナを使えば情報量を8/6=約1.3倍に抑えられます半角カタカナは濁点・半濁点の表現に1ビット要するので一概には言えません
復元時にinstrによる線形検索を行っているなど、速度上の課題はまだまだあるでしょう。
// 文字列型暗号作成スクリプト

// 参考:テキストボックスの編集監視
//      http://lhsp.s206.xrea.com/hsp_object2.html#4

#define ctype HIWORD(%1) (%1 >> 16 & 0xFFFF)
#module
#include "hspmath.as"
#const SPELL_KEY 0
// モジュールの初期化
#deffunc init_spell
    // 文字列型暗号の素 64文字
    sdim base, 64 * 2 + 1
    base  = "あいうえおかきくけこがぎぐげごさしすせそざじずぜぞ"    // 25文字
    base += "たちつてとだぢづでどなにぬねのはひふへほばびぶべぼ"    // 25 + 25 = 50文字
    base += "まみむめもやゆよらりるれろん"                          // 50 + 14 = 64文字
    return

// 指定した位置(ビット)から6ビットを取り出すマクロ
// バッファオーバーフローに注意
#define ctype peek6(%1%2=0) ((((peek(%1, (%2) / 8) << 8) | peek(%11 + (%2) / 8)) >> (10 - (%2) \ 8)) & 0x3F)

// 指定した位置(ビット)から6ビット書き込む命令
// バッファオーバーフローに注意
#deffunc poke6 var target, int index, int value
    i  = (peek(target, index / 8) << 8) | peek(target, index / 8 + 1)
    i ^= peek6(target, index) << (10 - (index \ 8))
    i |= (value & 0x3F) << (10 - (index \ 8))
    poke target, index / 8, (i >> 8) & 0xFF
    poke target, index / 8 + 1, i & 0xFF
    return

// パスワードから通常の文字列データへ変換
#deffunc spell2str var result, str _before
    before = _before
    len = strlen(before)
    randomize SPELL_KEY
    repeat len / 2
        code = (instr(base, 0strmid(before, cnt * 22)) / 2) ^ rnd(0x40)
        poke6 result, cnt * 6, code
    loop
    poke result, int(ceil(8.0 * len / 6.0)), 0
    return

// 通常の文字列データからパスワードに変換
#deffunc str2spell var result, str _before
    before = _before
    randomize SPELL_KEY
    // 対象となる文字列から6ビットずつ切りだし、ひらがなに変換
    for i, 0strlen(before) * 86
        // XOR演算によって より暗号っぽく
        wpoke result, i / 3wpeek(base, (peek6(before, i) ^ rnd(0x40)) * 2)
    next
    poke result, i / 30
    return
#global
    init_spell


    screen 0240200
    // 元の文字を代入する文字列型変数
    sdim before, 512
    // 文字列型暗号が代入される文字列型変数
    sdim result, 1536
    // テキストボックス作成
    mesbox before, ginfo_winxginfo_winy / 2, , 250
    hInput = objinfo_hwnd(stat)
    mesbox result, ginfo_winxginfo_winy / 2
    idResult = stat
    sendmsg objinfo_hwnd(idResult), $CF1  // 編集無効

    oncmd gosub *command0x0111            // WM_COMMAND
    stop

// テキストボックスの編集を監視する
*command
    if lparam == hInput {
        if HIWORD (wparam) = 0x300 {
            // 編集された場合は文字列型暗号を作って表示
            str2spell result, before
            objprm idResult, result
/*          // この行の"/*"を消すとタイトルに復元した文字列を表示
            sdim s, 512
            spell2str s, result
            title s
//*/

        }
    }
    return

2008年1月13日日曜日

数式の分解

正規表現を使って数式を分解し、文字列型配列変数に代入します。
日本語が使えないのが難点です。


関連:インタプリンタ電卓もどき
#runtime "hsp3cl"
#module
// 正規表現を利用した数式の分解
// 英数字およびアンダースコア・半角丸かっこと各種演算子のみ使用可能(日本語は無視)
#deffunc split_calc array result, str exp
    newcom oReg, "VBScript.RegExp"
    comres oMatches
    oReg("Global") = 1

    oReg("Pattern") = "[0-9\\.]+|\\+|-|\\*|/|%|=|\\w*\\(|\\)|\\w+"
    oReg -> "Execute" exp

    sdim result, 16, oMatches("Count")
    bracket_l = 0 : bracket_r = 0
    repeat oMatches("Count")
        oMatch = oMatches("Item"cnt)
        result(cnt) = oMatch("Value")
        s = strmid(result(cnt), -11)
        if s == "(" : bracket_l++ : else : if s == ")" : bracket_r++
    loop
    return bracket_l != bracket_r
#global

    exp = "s(r) = r * r * 3.14"
    mes exp + "\n"

    // 数式を分解
    split_calc result, exp
    if stat : mes "括弧の数が不正です。"

    // 結果の表示
    foreach result
        mes result(cnt)
    loop
    stop

2008年1月12日土曜日

Googleマップを利用する

経度と緯度を指定して、付近の地図を表示します。
// 経度と緯度を指定して、GoogleMapを表示する
#const COMBOX_HEIGHT 20
    axobj ie, "Shell.Explorer.2"ginfo_winxginfo_winy - COMBOX_HEIGHT
    if stat == -1 {
        dialog "ActiveXコントロールの配置に失敗しました。"1
        end
    }

    sdim places, 60
    places = "札幌ドーム\n東京ドーム\n原爆ドーム"
    // 緯度と経度…Geocodingにて検索
    ll(00) = 43.014605141.410877    // 札幌ドーム
    ll(01) = 35.705637139.751892    // 東京ドーム
    ll(02) = 34.395483132.453592    // 原爆ドーム

    objsize ginfo_winxCOMBOX_HEIGHT
    combox selected, 100, places
    hcombox = objinfo_hwnd(stat)

    oncmd gosub *on_selected0x0111
    gosub *jump
    stop

// 指定場所へのジャンプ
*jump
    url = "http://maps.google.co.jp/?ie=UTF8&z=17&om=1&ll=" + ll(0, selected) + "," + ll(1, selected) + "&output=embed&s=AARTsJqzARj-Z8VnW5pkPMLMmZbqrJcYpw"
    ie -> "Navigate" url
    return

// コンボボックスが変更された場合にジャンプ
*on_selected
    if (lparam == hcombox)&(wparam & 0x10000 != 0) {
        gosub *jump
    }
    return

2008年1月8日火曜日

Footy2の「イベントの監視」機能を利用する

hscallbk.dllを利用したイベントの監視。
ステータスバーに捕まえたイベントを報告します。

切り取りやアンドゥなどのショートカットキー(ctrl+A,C,V,X,Y,Z)をonkeyで実装しています。
#include "Footy2.as"
#include "hscallbk.as"
#include "user32.as"
#func Focus             ""  int, int, int, int
#func MoveCaret         ""  int, int, int, int
#func TextModified      ""  int, int, int
#func InsertModeChanged ""  int, int, int

*init
    gosub *createGUIObjects
    gosub *setCallBackFunctions
    onkey gosub *onPushKey
    stop

*createGUIObjects
    // ステータスバー作成
    // 参考:http://lhsp.s206.xrea.com/hsp_object8.html
    //   :http://yokohama.cool.ne.jp/chokuto/urawaza/statusbar.html
    winobj "msctls_statusbar32""ready", , $50000000
    statusbar_id = stat
    if statusbar_id == -1 {
        dialog "ウィンドウオブジェクトが正常に生成されませんでした"1
        end
    }
    // ステータスバーの高さを取得
    dim rect, 4
    GetWindowRect objinfo_hwnd(statusbar_id), varptr(rect)
    if stat == 0 {
        dialog "ステータスバーの座標取得に失敗しました"1
        end
    }
    statusbar_height = rect(3) - rect(1)

    // Footyエディタコントロール設置
    Footy2Create hwnd00ginfo_winxginfo_winy - statusbar_height, 0
    footy_id = stat
    if footy_id < 0 {
        dialog "Error : type " + stat1
        end
    }
    return

// コールバック関数の登録
*setCallBackFunctions
    setcallbk proc_Focus, Focus*onFocus
    setcallbk proc_MoveCaret, MoveCaret*onMoveCaret
    setcallbk proc_TextModified, TextModified*onTextModified
    setcallbk proc_InsertModeChanged, InsertModeChanged*onInsertModeChanged
    Footy2SetFuncFocus footy_id, varptr(proc_Focus), 0
    Footy2SetFuncMoveCaret footy_id, varptr(proc_MoveCaret), 0
    Footy2SetFuncTextModified footy_id, varptr(proc_TextModified), 0
    Footy2SetFuncInsertModeChanged footy_id, varptr(proc_InsertModeChanged), 0
    return

// フォーカスを得た/失った
*onFocus
    if callbkarg(3) & $FF {
        message = "Footyコントロールがフォーカスを得ました"
    } else {
        message = "Footyコントロールがフォーカスを失いました"
    }
    sendmsg objinfo_hwnd(statusbar_id), $4010, message
    return

// キャレットが移動した
*onMoveCaret
    sendmsg objinfo_hwnd(statusbar_id), $4010"キャレット位置が変更されました(" + callbkarg(2) + ":" + callbkarg(3) + ")"
    return

// テキストが編集された
*onTextModified
    switch callbkarg(2)
        case MODIFIED_CAUSE_CHAR
            message = "文字が入力されました(IMEオフ)"
            swbreak
        case MODIFIED_CAUSE_IME
            message = "文字が入力されました(IMEオン)"
            swbreak
        case MODIFIED_CAUSE_DELETE
            message = "Deleteキーが押されました"
            swbreak
        case MODIFIED_CAUSE_BACKSPACE
            message = "BackSpaceキーが押されました"
            swbreak
        case MODIFIED_CAUSE_ENTER
            message = "Enterキーが押されました"
            swbreak
        case MODIFIED_CAUSE_UNDO
            message = "元に戻す処理が実行されました"
            swbreak
        case MODIFIED_CAUSE_REDO
            message = "やり直し処理が実行されました"
            swbreak
        case MODIFIED_CAUSE_CUT
            message = "切り取り処理が行われました"
            swbreak
        case MODIFIED_CAUSE_PASTE
            message = "貼り付け処理が行われました"
            swbreak
        case MODIFIED_CAUSE_INDENT
            message = "インデント処理が行われました"
            swbreak
        case MODIFIED_CAUSE_UNINDENT
            message = "逆インデント処理が行われました"
            swbreak
        case MODIFIED_CAUSE_TAB
            message = "タブキーが押されました"
            swbreak
        default
            message = "テキストが編集されました(UNKNOWN)"
            swbreak
    swend
    sendmsg objinfo_hwnd(statusbar_id), $4010, message
    return

// 挿入/上書モードの変更
*onInsertModeChanged
    if callbkarg(2) & $FF {
        message = "挿入モードに変更されました"
    } else {
        message = "上書モードに変更されました"
    }
    sendmsg objinfo_hwnd(statusbar_id), $4010, message
    return

// ショートカットキー
*onPushKey
    keycode = iparam
    getkey ctrl, 17
    if ctrl {
        switch keycode
            case 'A'
                Footy2SelectAll footy_id
                swbreak
            case 'C'
                Footy2Copy footy_id
                swbreak
            case 'V'
                Footy2Paste footy_id
                swbreak
            case 'X'
                Footy2Cut footy_id
                swbreak
            case 'Y'
                Footy2Redo footy_id
                swbreak
            case 'Z'
                Footy2Undo footy_id
                swbreak
        swend
    }
    return



アクセラレータキーを利用したスクリプトがこちら。
ウィンドウの最大化にも対応しています。
// アクセラレータキーを使用
// Footy2付属のC++サンプルとほぼ同等
#include "Footy2.as"
#include "hscallbk.as"
#include "user32.as"
#func Focus             ""  int, int, int, int
#func MoveCaret         ""  int, int, int, int
#func TextModified      ""  int, int, int
#func InsertModeChanged ""  int, int, int

#const FVIRTKEY         0x0001
#const FNOINVERT        0x0002
#const FSHIFT           0x0004
#const FCONTROL         0x0008
#const FALT             0x0010

#const WM_SIZE          0x0005
#const WM_COMMAND       0x0111

#enum IDM_UNDO = 1
#enum IDM_REDO
#enum IDM_CUT
#enum IDM_COPY
#enum IDM_PASTE
#enum IDM_SELECTALL

// 初期化作業
*init
    gosub *createGUIObjects
    gosub *createAccelTable
    gosub *setCallBackFunctions
    oncmd gosub *on_resizeWM_SIZE
    oncmd gosub *on_commandWM_COMMAND
    onexit goto *on_exit
    dim msg, 7
    Footy2SetFocus footy_id

// メッセージループ
*msg_loop
    GetMessage varptr(msg), 000
    ret = stat
    if (ret == 0)|(ret == -1) {
        goto *on_exit
    }
    TranslateAccelerator hwnd, haccel, varptr(msg)
    if stat == 0 {
        TranslateMessage varptr(msg)
        DispatchMessage  varptr(msg)
    }
    goto *msg_loop

#define WS_MAXIMIZEBOX  0x00010000
#define WS_SIZEBOX      0x00040000
*createGUIObjects
    // ウィンドウ初期化
    screen 0ginfo_dispxginfo_dispy
    GetWindowLong hwnd, -16
    SetWindowLong hwnd, -16stat | WS_MAXIMIZEBOX | WS_SIZEBOX
    title "Footy2サンプル on Footy2 ver." + GetFooty2Ver()
    width 640480

    // ステータスバー作成
    // 参考:http://lhsp.s206.xrea.com/hsp_object8.html
    //   :http://yokohama.cool.ne.jp/chokuto/urawaza/statusbar.html
    winobj "msctls_statusbar32""ready", , $50000000
    statusbar_id = stat
    if statusbar_id == -1 {
        dialog "ウィンドウオブジェクトが正常に生成されませんでした"1
        end
    }

    // ステータスバーの高さを取得
    dim rect, 4
    GetWindowRect objinfo_hwnd(statusbar_id), varptr(rect)
    if stat == 0 {
        dialog "ステータスバーの座標取得に失敗しました"1
        end
    }
    statusbar_height = rect(3) - rect(1)

    // Footyエディタコントロール設置
    Footy2Create hwnd00ginfo_winxginfo_winy - statusbar_height, 0
    footy_id = stat
    if footy_id < 0 {
        dialog "Error : type " + stat1
        end
    }
    return

// アクセラレータテーブルの作成
// 参考:「アクセラレータ - HSP開発wiki」
//    http://hspdev-wiki.net/?%A5%A2%A5%AF%A5%BB%A5%E9%A5%EC%A1%BC%A5%BF
*createAccelTable
    sdim accel, 6*6

    key = 'Z''Y''X''C''V''A'
    repeat 6
        poke accel,  cnt*6+0FCONTROL | FVIRTKEY
        wpoke accel, cnt*6+2, key(cnt)
        wpoke accel, cnt*6+4cnt+1
    loop

    CreateAcceleratorTable varptr(accel), 6
    haccel = stat
    if haccel == 0 {
        dialog "アクセラレータテーブル作成に失敗しました"1
    }
    return

// コールバック関数の登録
*setCallBackFunctions
    setcallbk proc_Focus, Focus*onFocus
    setcallbk proc_MoveCaret, MoveCaret*onMoveCaret
    setcallbk proc_TextModified, TextModified*onTextModified
    setcallbk proc_InsertModeChanged, InsertModeChanged*onInsertModeChanged
    Footy2SetFuncFocus footy_id, varptr(proc_Focus), 0
    Footy2SetFuncMoveCaret footy_id, varptr(proc_MoveCaret), 0
    Footy2SetFuncTextModified footy_id, varptr(proc_TextModified), 0
    Footy2SetFuncInsertModeChanged footy_id, varptr(proc_InsertModeChanged), 0
    return

// フォーカスを得た/失った
*onFocus
    if callbkarg(3) & $FF {
        message = "Footyコントロールがフォーカスを得ました"
    } else {
        message = "Footyコントロールがフォーカスを失いました"
    }
    sendmsg objinfo_hwnd(statusbar_id), $4010, message
    return

// キャレットが移動した
*onMoveCaret
    sendmsg objinfo_hwnd(statusbar_id), $4010"キャレット位置が変更されました(" + callbkarg(2) + ":" + callbkarg(3) + ")"
    return

// テキストが編集された
*onTextModified
    switch callbkarg(2)
        case MODIFIED_CAUSE_CHAR
            message = "文字が入力されました(IMEオフ)"
            swbreak
        case MODIFIED_CAUSE_IME
            message = "文字が入力されました(IMEオン)"
            swbreak
        case MODIFIED_CAUSE_DELETE
            message = "Deleteキーが押されました"
            swbreak
        case MODIFIED_CAUSE_BACKSPACE
            message = "BackSpaceキーが押されました"
            swbreak
        case MODIFIED_CAUSE_ENTER
            message = "Enterキーが押されました"
            swbreak
        case MODIFIED_CAUSE_UNDO
            message = "元に戻す処理が実行されました"
            swbreak
        case MODIFIED_CAUSE_REDO
            message = "やり直し処理が実行されました"
            swbreak
        case MODIFIED_CAUSE_CUT
            message = "切り取り処理が行われました"
            swbreak
        case MODIFIED_CAUSE_PASTE
            message = "貼り付け処理が行われました"
            swbreak
        case MODIFIED_CAUSE_INDENT
            message = "インデント処理が行われました"
            swbreak
        case MODIFIED_CAUSE_UNINDENT
            message = "逆インデント処理が行われました"
            swbreak
        case MODIFIED_CAUSE_TAB
            message = "タブキーが押されました"
            swbreak
        default
            message = "テキストが編集されました(UNKNOWN)"
            swbreak
    swend
    sendmsg objinfo_hwnd(statusbar_id), $4010, message
    return

// 挿入/上書モードの変更
*onInsertModeChanged
    if callbkarg(2) & $FF {
        message = "挿入モードに変更されました"
    } else {
        message = "上書モードに変更されました"
    }
    sendmsg objinfo_hwnd(statusbar_id), $4010, message
    return

// WM_COMMANDメッセージを受け取った
*on_command
    switch wparam & $FFFF
        case IDM_UNDO
            Footy2Undo footy_id
            swbreak
        case IDM_REDO
            Footy2Redo footy_id
            swbreak
        case IDM_CUT
            Footy2Cut footy_id
            swbreak
        case IDM_COPY
            Footy2Copy footy_id
            swbreak
        case IDM_PASTE
            Footy2Paste footy_id
            swbreak
        case IDM_SELECTALL
            Footy2SelectAll footy_id
            swbreak
    swend
    return

// WM_SIZEメッセージを受け取った
#const  SIZE_RESTORED   0
#const  SIZE_MAXIMIZED  2
*on_resize
    if (wparam == SIZE_RESTORED) | (wparam == SIZE_MAXIMIZED) {
        Footy2Move footy_id, 00ginfo_winxginfo_winy - statusbar_height
        sendmsg objinfo_hwnd(id_statusbar), WM_SIZESIZE_RESTORED0
    }
    return 0

// アクセラレータテーブルの削除
*destroyAccelTable
    if haccel != 0 {
        DestroyAcceleratorTable haccel
    }
    return

// 終了時処理
*on_exit
    gosub *destroyAccelTable
    end

Footy2.as正式版を公開しました

すべての命令・関数・マクロと定数を記述したHSP3向けヘッダファイルをFooty2のプロジェクトページからダウンロードできます。(コールバック関数の利用はhscallbk.dllが必要です)

リポジトリブラウザ→trunk→HSPとリンクを辿ってダウンロードしてください。

2008年1月7日月曜日

APIを利用して英語を日本語に翻訳するモジュール

英語を日本語に翻訳します。
ネットに接続するため、少し時間がかかります。
// 英語->日本語変換サンプル
// 翻訳APIを使用
//     http://muumoo.jp/news/2007/05/09/0translationapi.html
// 参考:mod_rss.as

#module mod_translate
#deffunc rss2load_init@mod_translate
    newcom oDom,"Microsoft.XMLDOM"
    oDom("async") = "FALSE"
    comres elm_desc
    return

#deffunc rss2load@mod_translate array desc, str url, int p_max
    oDom->"load" url
    oRoot = oDom("documentElement")
    if varuse(oRoot) == 0 : return 1
    if oRoot("tagName") != "rss" : return 2

    maxnum = p_max
    if maxnum <= 0 : maxnum = 5

    oDom->"getElementsByTagName" "description"
    max = limit(elm_desc("length"), 1, maxnum)

    sdim desc, 64, max
    repeat max
        node = elm_desc("item"cnt)
        node2 = node("firstChild")
        desc(cnt) = node2("nodeValue")
    loop

    return 0

#deffunc rss2load_clean onexit
    if vartype(oRoot) == vartype("comobj") {
        delcom node : delcom node2 : delcom oRoot
    }
    delcom elm_desc : delcom oDom
    return

// 英文を和訳します。変換に成功するとstatに0が代入され、第1引数の変数に変換結果が代入されます。
// 変換に失敗するとstatに1が代入されます。
#deffunc eng2jp var result, str before, local after
    rss2load after, "http://pipes.yahoo.com/poolmmjp/ej_translation_api?_render=rss&text=" + before
    if (stat == 0)&(length(after) == 2) {
        // after(0)にはAPIの説明が代入されている
        result = after(1)
        return 0
    } else {
        return 1
    }
#global
    rss2load_init@mod_translate
// モジュールここまで

    target = "Good morning! How are you today?""I'm fine, thank you. And you?""So so."
    foreach target
        mes target(cnt)
        eng2jp result, target(cnt)
        if stat == 0 : mes "-> " + result
    loop
    stop

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.20784
    return vptr.1

#modinit str _content
    set_tree_content thismod, _content
    dimtype children, 51
    return getaptrthismod )

#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
    ifvaruse( 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
        ifvaruse( 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_LASTTVIF_TEXT
    tvins(6) = varptr(bufText), strlen(bufText)
    sendmsg h_treeview, TVM_INSERTITEM0varptr(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%4newmod %1, m_treeview, %2%3%4
#modinit var root, int _width, int _height
    // コモンコントロールライブラリ初期化(無くても動作する?)
    initCCEx = 80x00000002
    InitCommonControlsEx varptr(initCCEx)
    if stat == 0 : return -1

    // コントロールの作成
    style = 0x40000000 | 0x10000000 | 0x0001 | 0x0002 | 0x0200
    CreateWindowEx 0"SysTreeView32""", style, ginfo_cxginfo_cy, _width, _height, hwnd000
    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, 100ginfo_winy
    if stat == -1 {
        dialog "ツリービューの作成に失敗しました。"1
        end
    }
    // ツリーを表示
    pos 1000
    show_tree tree

    stop