トップ 差分 一覧 ツリー ソース 検索 インデックス検索 ヘルプ RSS RSS10 RSS20 ATOM ログイン

SourceCode はてなブックマーク livedoorクリップ

ForMobile
6/18 FeedLoad HSPでRSS/RDF/Atomを簡単に取り扱ったり、PodCastに対応したり

ここは

とにかく自分が役に立つ、あるいは面白いかも、とか思ったっぽいHSPのコードを適当に書き綴ってゆきます。
他にHSPに関係することであれば別のことも書くかもしれませんが…

ここにあるコードは利用も転載も何もかも自由です。
好きにプログラムに組み込むなり、自分のblogに載せるなりすれば良いんじゃないでしょうか[1]

他に、ここに載せるには規模が大きすぎるモジュール類をHSPModulesで公開しています。

区分について

「APIを使った」とか、「メッセージを使った」に対して、「基本どれも使ってるんじゃね?」とかいう無粋な指摘は不要です。
意識して使っているものに対して書いてます。

どこかでよく見たアレ with HSP

他の言語ではよく見る処理を、HSPでやってみよう。
SourceCodeHSP

WinAPIを使ったスクリプト

(Win)APIの使い方

  1. APIを含むDLLを指定。
  2. 使用するAPIを指定。
  3. 使いたい場面で使用。
1
2
3
4
#uselib "test.dll"
#func Test "Test" int
        Test 0
        stop

画面の一部をコピー

ディスプレイに表示されている画面の一部を、HSPのウィンドウに描画する。
例ではデスクトップの一部、あるいは最前面のウィンドウの一部を取得する。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#uselib "gdi32.dll"
#func BitBlt "BitBlt" sptr,int,int,int,int,sptr,int,int,int
#uselib "user32.dll"
;#cfunc GetDesktopWindow "GetDesktopWindow"
#cfunc GetForegroundWindow "GetForegroundWindow"
#cfunc GetWindowDC "GetWindowDC" sptr
#func ReleaseDC "ReleaseDC" sptr,sptr
        title "3秒後に取得"
        wait 300
        hWndDT=0                        ;デスクトップウィンドウの場合。
                                        ;GetWindowDC(NULL)でデスクトップのhDCが取得できるので
                                        ;必ずしもGetDesktopWindow()は必要ではない
        ;hWndDT=GetForegroundWindow()        ;最前面のウィンドウの場合、ここのコメントアウトを外す
        hDCDT=GetWindowDC(hWndDT)        ;該当ウィンドウのhDC取得
        BitBlt hdc,0,0,640,480,hDCDT,0,0,$CC0020
        redraw 1
        ReleaseDC hWndDT,hDCDT

補足1

デスクトップ画面のハードコピーをとりたいのであれば、PrintScreenキーを押すといいんじゃないかな。
アクティブウィンドウのハードコピーはAlt+PrintScreenだぜ!
PrintScreenは「PrtScn」とか書いてることもあるぞ!
※検索エンジンから来る人が結構いるので追記。

補足2

最前面のウィンドウを取得する際、該当ウィンドウサイズより大きな値を指定すると、外側にあるウィンドウまで描画される。

クリップボードの更新を検出

クリップボードのデータが変更されたときに、検出するスクリプト。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
#uselib "user32.dll"
#cfunc SetClipboardViewer "SetClipboardViewer" sptr
#func ChangeClipboardChain "ChangeClipboardChain" sptr,sptr
#define WM_CHANGECBCHAIN        $0000030D
#define WM_DRAWCLIPBOARD        $00000308

        oncmd gosub *chgcripboard,WM_DRAWCLIPBOARD        ;クリップボードの更新
        oncmd gosub *chgcbchain,WM_CHANGECBCHAIN        ;クリップボードチェインの変更
        onexit *exitapp                                        ;終了処理

        NXTWIN=SetClipboardViewer(hwnd)                        ;クリップボードチェインへの参加
        stop

*chgcripboard
        if NXTWIN:sendmsg NXTWIN,WM_DRAWCLIPBOARD,wparam,lparam
        mes "クリップボードのデータが更新又は削除されました。"
        return 0

*chgcbchain
        if wparam=NXTWIN{
                NXTWIN=lparam
        }else{
                if NXTWIN:sendmsg NXTWIN,WM_CHANGECBCHAIN,wparam,lparam
        }
        mes "クリップボードチェインに変更がありました"
        return 0

*exitapp
        ChangeClipboardChain hwnd,NXTWIN
        end

補足

ソースコードだけだと意味が分かりにくいと思うので、簡単な解説を書いてみた。
SourceCode/Clipboard

デュアルディスプレイ環境で、スクリーンセーバーを作る

HSPのginfo_winx/ginfo_winyでは、メインに設定されているモニタの大きさしか取得できないので、
複数のディスプレイの全て合わせた仮想画面の大きさを取得し、それを使って全画面表示する。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#uselib "user32.dll"
#func GetSystemMetrics "GetSystemMetrics" sptr
#define SM_XVIRTUALSCREEN        $0000004C
#define SM_YVIRTUALSCREEN        $0000004D
#define SM_CXVIRTUALSCREEN        $0000004E
#define SM_CYVIRTUALSCREEN        $0000004F

        onclick *clclc
        GetSystemMetrics SM_XVIRTUALSCREEN:DEFXX=stat
        GetSystemMetrics SM_YVIRTUALSCREEN:DEFYY=stat
        GetSystemMetrics SM_CXVIRTUALSCREEN:XX=stat
        GetSystemMetrics SM_CYVIRTUALSCREEN:YY=stat
        bgscr 2,XX,YY,0,DEFXX,DEFYY
        pos DEFXX*-1,DEFYY*-1
        mes "仮想ディスプレイ左上座標:"+DEFXX+","+DEFYY
        mes "仮想画面サイズ:"+XX+","+YY
        stop
*clclc
        end

補足

GetSystemMetrics関数を用いて、仮想画面の大きさ、及び左上の座標を取得しています。
(少しは詳しい説明:SourceCode/DualDisplay)
ただし、この方法では複数ディスプレイ全体で1つの画面、と言う描画しか出来ません。

実装例

ScreenSaver簡易実装キット for HSP - HSP向けのスクリーンセーバー開発キット デュアルディスプレイ対応含む
DualMasters - デュアルディスプレイ対応でないスクリーンセーバーをそのような環境で使えるようにするソフト

デュアルディスプレイ環境で、個々のディスプレイの事を気にしたスクリーンセーバーを作る

上の方法のみでは、個々のディスプレイの境界などを気にする事ができないので、
それぞれのデータを取得してみる。要hscallbk。→ちょくとのページ
HSP以外の場合は、コールバック関数が定義できる(あるいは何らかの方法で対応できる)言語なら実装可能。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
//コールバック関数定義
#include "hscallbk.as"
#uselib ""
#func MonitorEnumProc "" int,int,int,int

//USER32
#include "user32.as"
#define SM_XVIRTUALSCREEN        $0000004C
#define SM_YVIRTUALSCREEN        $0000004D
#define SM_CXVIRTUALSCREEN        $0000004E
#define SM_CYVIRTUALSCREEN        $0000004F
#define SM_CMONITORS        $00000050

//ディスプレイ情報取得。ディスプレイの数と位置関係。
        GetSystemMetrics SM_CMONITORS:DISPCNT=stat
        dim DSPDT,DISPCNT,4
        DCNT=0:BUF=0:SBUF=""
        GetSystemMetrics SM_XVIRTUALSCREEN:DEFXX=stat
        GetSystemMetrics SM_YVIRTUALSCREEN:DEFYY=stat
        GetSystemMetrics SM_CXVIRTUALSCREEN:XX=stat
        GetSystemMetrics SM_CYVIRTUALSCREEN:YY=stat
        setcallbk MONENUMPROC,MonitorEnumProc,*OnMonitorEnumProc
        EnumDisplayMonitors 0,0,varptr(MONENUMPROC),0
        bgscr 1,XX,YY,0,DEFXX,DEFYY
        font "",100
        repeat DISPCNT
                line DSPDT(cnt,0),DSPDT(cnt,3),DSPDT(cnt,2),DSPDT(cnt,1);左下から右上に線を引く
                pos DSPDT(cnt,0),DSPDT(cnt,1)                                ;左上にディスプレイ番号を表示
                mes cnt+1
                boxf DSPDT(cnt,2)-100,DSPDT(cnt,3)-100,DSPDT(cnt,2)-5,DSPDT(cnt,3)-5;右下に矩形を描く
        loop
        stop

//コールバック関数の中身
//システムからコールバックがあるたびにここにサブジャンプする
*OnMonitorEnumProc
        dupptr RECT,callbkarg(2),16                ;今欲しい引数は2番目だけ
        repeat 4
                if cnt\2=0:BUF=DEFXX:else:BUF=DEFYY        ;値は仮想画面の座標系で返るので、仮想画面の左上を0,0とした値に修正
                DSPDT(DCNT,cnt)=RECT(cnt)-BUF
        loop
        DCNT++
        return 1

補足

nVidiaのグラフィックボードのドライバの機能の「垂直スパン」「水平スパン」あるいは、
他のドライバであっても同等の機能を用いて、複数のディスプレイを組み合わせて1つのディスプレイであると
Windowsに認識させている場合、この方法でも個々のディスプレイの大きさなどは取得できないようです。

半透明ウィンドウを作る

Windows2000/XP/Vistaで実装可能な、半透明ウィンドウを作る。
ちなみに、ほとんど同じ手順で従来のリージョン相当のウィンドウも作れる。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
;#include "user32.as"
#uselib "User32.dll"
#func GetWindowLong "GetWindowLongA" sptr,int
#func SetWindowLong "SetWindowLongA" sptr,int,int
#func SetLayeredWindowAttributes "SetLayeredWindowAttributes" sptr,int,int,int
#define WS_EX_LAYERED 0x00080000

        ;いわゆる普通の半透明ウィンドウ
        title "0"
        GetWindowLong hwnd,-20
        ;ウィンドウにWS_EX_LAYEREDスタイルを追加する
        ;これをしないと半透明効果は得られない
        SetWindowLong hwnd,-20,stat|WS_EX_LAYERED
        ;SetLayeredWindowAttributesの第3引数で透明度を指定
        ;255で不透明、0で完全に透明
        SetLayeredWindowAttributes hwnd,0,200,2
        ;ここまでで処理は完了している。簡単でしょう?(ボブ風

        ;かつてリージョンと呼ばれたものに似ている半透明ウィンドウ
        bgscr 1,,,,200,200
        title "1"
        GetWindowLong hwnd,-20
        SetWindowLong hwnd,-20,stat|WS_EX_LAYERED
        ;SetLayeredWindowAttributesの第2引数で透明色となる色を指定
        ;ちなみに$nnBBGGRRとなっている。nは使わない。
        ;第4引数が3である事に注意。
        SetLayeredWindowAttributes hwnd,0x00FFFFFF,200,3

        ;以下、適当にそれっぽく見えるように描画してるだけ
        color ,255,255
        boxf 0,0,ginfo_winx,ginfo_winy
        color 255,255,255
        boxf 0,0,ginfo_winx-3,ginfo_winy-3
        color 255
        boxf 100,0,300,300
        color ,,255
        boxf 200,100,500,400
        color ,255
        pos 0,50
        font "",70,1
        mes "WindowID:1"
        stop

補足

Windows2000でNT系のみに追加された機能であるため、当然ながらそれ以降のNT系Windowsでしか使えない。
具体的には、95とか98とかMeとか、あるいはそれ以前のものは対象外。
これはリージョン風ウィンドウの方も同様。

SetLayeredWindowAttributes()の第4引数は、どのパラメータを使うかを示す値で、
%01(=1)なら透明色指定が、%10(=2)なら透明度指定が有効となる。%11(=3)はその組み合わせ。

UpdateLayeredWindow()をつかうとピクセル単位で透明度を持つウィンドウを作成できるらしいが、
そこそこ複雑なようなのでここでは示さない。使わなさそうだし。

HSPで#funcを使いつつ動的にDLLを読み出す

通常HSP3からDLLを呼ぶ場合、#uselibと#funcを使って事前に関数を定義する必要があります。
しかしこの方法では動的に(たとえばプラグインなどでDLLの名前が不明な場合に)読み出せません。
かといって、LoadLibraryとGetProcAddressを用いる方法だと関数のコールにcallfunc関数を用いねばならず、
呼び出している関数が何なのかわかりにくくなってしまう欠点があります。

そこで、#funcであらかじめAPIを定義しておき、あとからLoadLibraryでDLLをロードして関数を使う、という方法。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
//DLL動的呼び出しに必要なAPIセット
#uselib "kernel32.dll"
;#func GetProcAddress "GetProcAddress" sptr,sptr
#cfunc LoadLibrary "LoadLibraryA" sptr
#func FreeLibrary "FreeLibrary" sptr

//動的に呼び出したい関数だけを定義
//ここではUser32に含まれるMessageBoxAを指定
#uselib ""        ;ここでは指定しない
;#uselib "user32.dll"
#func MessageBoxA "MessageBoxA" int,sptr,sptr,int

#define LIBDAT_FLAG_NONE 0        // 無効
#define LIBDAT_FLAG_DLL 1        // DLL(未インポート)
#define LIBDAT_FLAG_DLLINIT 2        // DLL(インポート済)
#define LIBDAT_FLAG_MODULE 3        // モジュール変数
#define LIBDAT_FLAG_COMOBJ 4        // 定義済みCOMオブジェクト

        onexit *exitapp

        //この辺はlibptrのサンプルからほぼ丸写し
        dupptr lptr,libptr(MessageBoxA),28        ; STRUCTDAT構造体を取得
        lib_id=wpeek(lptr,0)
        mref hspctx,68
        linf_adr=lpeek( hspctx, 832 )
        dupptr linf,linf_adr + lib_id*16,16        ; LIBDAT構造体を取得

        //DLLをLoadLibraryでロード、LIBDAT構造体にセット
        hUser32=LoadLibrary("user32.dll")
        linf(0)=LIBDAT_FLAG_DLLINIT        ;DLLがロードされてるかどうかのフラグ
        linf(2)=hUser32        ;ロードしたDLLのハンドル

        //で、MessageBoxAを呼んでみる
        MessageBoxA hwnd,"実験なんだよね。","TEST",0
        stop

*exitapp
        FreeLibrary hUser32
        end

補足

これは、HSPの「関数や外部命令郡を管理する構造体」の、DLLハンドルを保存する場所にむりやり
別途ロードしたDLLハンドルを差し込むことでHSPをだます手法です。
詳細を調べていないので不明ですが、FreeLibraryは不要かもしれません。

なお、当然のことながら想定外の使い方であると思われるため、HSPのバージョンによっては動かなかったり
環境によっては不具合が出たりする可能性は否定できません。

ウィンドウメッセージを使ったスクリプト

ウィンドウメッセージの取り方

  1. 取得したいメッセージを指定。
  2. あとは、メッセージが飛んでくれば指定ラベルに飛ぶ。
1
2
3
4
5
        oncmd *eventchk,WM_TEST
        stop
*eventchk
        mes "イベントが発生しました。"
        stop

マウス関連イベント

マウス関連のイベントを取得するサンプル。
左クリック、マウスの移動、マウスホイールの回転を検出する。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
#define WM_LBUTTONDOWN        $00000201
#define WM_LBUTTONUP        $00000202
#define WM_MOUSEMOVE        $00000200
#define WM_MOUSEWHEEL        $0000020A
        screen 0,140,200,1
        C=255
        ;onclick gosub *mouseldown
        oncmd gosub *mouseldown,WM_LBUTTONDOWN
        oncmd gosub *mouselup,WM_LBUTTONUP
        oncmd gosub *mousewheel,WM_MOUSEWHEEL
        oncmd gosub *mousemove,WM_MOUSEMOVE
        pos 60,0
        mes "W:0"
        stop

*mouseldown
        C=128
        gosub *redrawdisp
        return

*mouselup
        C=255
        gosub *redrawdisp
        return

*mousewheel
        BUF=(wparam>>16)/120
        W-=BUF
        gosub *redrawdisp
        return

*mousemove
        X=lparam&65535
        Y=lparam>>16
        gosub *redrawdisp
        return

*redrawdisp
        redraw 0
        color C,C,C:boxf 0,0,ginfo_winx,ginfo_winy:color
        pos 60,W
        mes "W:"+W
        line X,0,X,ginfo_winy
        line 0,Y,ginfo_winx,Y
        redraw 1
        return

補足

マウス関連操作について、

  • マウスの移動とホイールの回転は、mousex/mousey/mousewの各システム変数を監視すれば検出できる。
  • マウスのクリックは、onclick命令でイベントとして検出できる。

よってここで書いているコードはある意味で過剰ともいえるが、サンプルの方法には

  • ループを使わないのでシステム負荷的に有利
  • 変化の取りこぼしがないので正確
    • 例えば、ループの場合1週に時間がかかると途中検出されるべきだった変化を取りこぼすことがある
  • マウスボタンを離す操作を検出できる

などの利点がある。コードの目的や状況、組み方などで使い分けるべきであると思う。

Skypeにコマンドを送る

SkypeAPIを利用して、SkypeをHSPからコントロールします。
このサンプルでは、自分自身のムードテキストを書き換えます。
Skype Ver.2.0以降と共にお試しください。
※多少エラーが出ることがあるようなので、何回か実行してみてください。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
#uselib "user32.dll"
#func PostMessage "PostMessageA" sptr,sptr,sptr,sptr
#func RegisterWindowMessage "RegisterWindowMessageA" str
#define WM_COPYDATA 0x004A
#uselib "kernel32.dll"
;#func MultiByteToWideChar "MultiByteToWideChar" int,int,sptr,int,wptr,int
#func WideCharToMultiByte "WideCharToMultiByte" int,int,wptr,int,sptr,int,nullptr,nullptr
#define CP_UTF8        0xFDE9
        RegisterWindowMessage "SkypeControlAPIDiscover":SkypeCAPID=stat
        RegisterWindowMessage "SkypeControlAPIAttach":SkypeATC=stat
        oncmd gosub *skypeattach,SkypeATC
        oncmd gosub *copydata,WM_COPYDATA
        ;sendmsg 0xFFFF,SkypeCAPID,hwnd,0
        PostMessage 0xFFFF,SkypeCAPID,hwnd,0
        repeat
                title ""+cnt
                wait 1
                if hSkype:goto *sendmoodmsg
                loop
        stop

*sendmoodmsg
        sdim SBUF,1024
        sdim SBUF2,4096
        ;SBUF="PING"
        SBUF="SET PROFILE MOOD_TEXT 実験"
        cnvstow SBUF2,SBUF;本当はMultiByteToWideChar使ったほうがよい
        BUF(1)=strlen(SBUF)*2+2
        WideCharToMultiByte CP_UTF8,0,varptr(SBUF2),BUF(1),0,0:BUF=stat
        sdim SBUF,BUF+2
        WideCharToMultiByte CP_UTF8,0,varptr(SBUF2),BUF(1),varptr(SBUF),BUF
        
        BUF=0,strlen(SBUF)+2,varptr(SBUF)
        sendmsg hSkype,WM_COPYDATA,hwnd,varptr(BUF)
        if stat:mes "コマンド送信成功("+stat+")":else:mes "送信失敗"
        stop

*copydata
        if wparam=hSkype{
                dupptr BUF,lparam, 12
                data_id   = BUF(0)
                dupptr data_ref,BUF(2),BUF(1),2
                mes "copydata msg from Skype("+wparam+")"
                ;日本語が含まれてると化ける
                ;MultiByteToWideChar→WideCharToMultiByteで読めるように出来る(はず)
                mes data_ref
        }
        return 1

*skypeattach
        if lparam=0:hSkype=wparam:mes "接続に成功。hSkype="+wparam
        if lparam=1:mes "接続要求中。"
        if lparam=2:mes "接続拒否。"
        if lparam=3:mes "API使用不可能。"
        return 1

標準命令のみのスクリプト

gmodeが有効なboxf

半透明な矩形を描くにはgmodeとgrectを使いますが、grectは引数の書き方が異なるため今までと同じ感覚で使う事は出来ません。
そこで、gsquareをboxfのように使う事を考えます。

実装

1
2
3
4
#undef boxf
#define _gsqstt(%1,%2,%3,%4) %ttest %i=%2,%2,%4,%4:%i=%1,%3,%3,%1
#define _gsqrun %ttest gsquare -1,%o,%o
#define boxf(%1,%2,%3,%4) _gsqstt %1,%2,%3,%4:_gsqrun

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#undef boxf
#define _gsqstt(%1,%2,%3,%4) %ttest %i=%2,%2,%4,%4:%i=%1,%3,%3,%1
#define _gsqrun %ttest gsquare -1,%o,%o
#define boxf(%1,%2,%3,%4) _gsqstt %1,%2,%3,%4:_gsqrun
        dialog "*",16
        if stat=0:end
        picload refstr
        color 255
        redraw 0
        repeat 3
                SPY=cnt*130
                MODE=cnt+3
                if MODE>3:MODE++
                repeat 10
                        _X=cnt
                        repeat 10
                                BUF=(_X+cnt)*255/20
                                gmode MODE,,,BUF
                                boxf 12*_X+10,12*cnt+10+SPY,12*_X+22,12*cnt+22+SPY
                        loop
                loop
        loop
        redraw 1

補足

この方法だといわゆる標準のboxfは使えなくなる(grectで置き換えられてしまうため)。
標準命令なboxfを使うには、boxf@hspとする。

補足2

前はgrectを使ってた。理由は、gsquareの存在を完膚なきまでに忘れていたためである。

MikeTimeエンコーダ/デコーダ

ミケネコ研究所内、MikeTime フォーマットにて提唱されている、MikeTimeを利用するサンプルモジュールです。
このモジュールで、

  • 任意時間に対するMikeTimeの取得
  • 任意のMikeTimeのデコード
  • 実行時点での時刻のMikeTimeの取得

が単純な命令によって実現できます。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
/*モジュール開始*/
#module "MikeTime"
#deffunc mtime_init
        MB60="0123456789ABCDEFGHIJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
        NUMB="0123456789"
        return
#deffunc mtime_encode array TM,local RET,local BUF
        sdim RET,9
        poke RET,0,peek(MB60,TM(0)/100)
        BUF=TM(0)-TM(0)/100*100
        RET+=""+(BUF/10)+(BUF-BUF/10*10)
        repeat 5
                poke RET,3+cnt,peek(MB60,TM(1+cnt))
        loop
        return RET
#deffunc mtime_decode array RTM,str MTIME,local BUF,local SBUF,local SBUF2,local CONT
        dim BUF,8
        SBUF=""
        SBUF2=""+MTIME
        repeat 256
                poke SBUF,0,peek(SBUF2,cnt)
                if CONT=1|CONT=2{
                        if instr(NUMB,0,SBUF)!-1:BUF(CONT)=instr(NUMB,0,SBUF):CONT++
                }else{
                        if instr(MB60,0,SBUF)!-1:BUF(CONT)=instr(MB60,0,SBUF):CONT++
                }
                if CONT>=8:break
        loop
        if CONT<8:return -1
        RTM(0)=BUF(0)*100+BUF(1)*10+BUF(2)
        repeat 5
                RTM(1+cnt)=BUF(3+cnt)
        loop
        return 0
#deffunc mtime_encode_now local TM
        TM(0)=gettime(0)
        TM(1)=gettime(1)
        TM(2)=gettime(3)
        TM(3)=gettime(4)
        TM(4)=gettime(5)
        TM(5)=gettime(6)
        mtime_encode TM
        return refstr
#global
        mtime_init
/*モジュール終了*/
        dim NOW,8
        width 200,20
        SBUF="":SBUF2=""
        repeat
                mtime_encode_now:SBUF=refstr
                if SBUF!SBUF2{
                        redraw 0
                        title SBUF
                        color 255,255,255
                        boxf 0,0,ginfo_winx,ginfo_winy
                        color
                        pos 0,0
                        mtime_decode NOW,SBUF
                        mes ""+NOW(0)+"/"+NOW(1)+"/"+NOW(2)+" "+NOW(3)+":"+NOW(4)+":"+NOW(5)
                        redraw 1
                        SBUF2=""+SBUF
                }
                wait 1
        loop

BASE64エンコーダ

BASE64の変換をするもの。
HSPModulesに移動。

RingClock

日付表示付のアナログ時計。
「時計の針が動くなんて常識にとらわれすぎじゃね?」という発想から作成。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#define CX 320
#define CY 240
#define R0 18*10
#const R00 R0+18
#const R1 R0-18
#const R2 R1-18
#const R3 R2-18
#const R4 R3-18
#const R5 R4-18
#define M_PI 3.14159265358979323846
#define D12 M_PI*2/12
#define D24 M_PI*2/24
#define D31 M_PI*2/31
#define D60 M_PI*2/60
#define DSS M_PI*2/1000
#define CMAIN ,,255
#define CSUB 200,200,200
        font "MS UI Gothic",12,1
*top
        redraw 0
        color 255,255,255
        boxf 0,0,640,480
        color
        ;分、秒
        repeat 60,1
                BUF=D60*(1.0*gettime(7)/1000+gettime(6)+cnt)-D60/2
                pos sin(BUF)*R0+CX,cos(BUF)*R0+CY
                if gettime(6)=(60-cnt):color CMAIN:else:color CSUB
                mes 60-cnt
                BUF=D60*(1.0*gettime(6)/60+gettime(5)+cnt)-D60/2
                pos sin(BUF)*R1+CX,cos(BUF)*R1+CY
                if gettime(5)=(60-cnt):color CMAIN:else:color CSUB
                mes 60-cnt
        loop
        ;時
        repeat 24,1
                BUF=D24*(1.0*gettime(5)/60+gettime(4)+cnt)-D24/2
                pos sin(BUF)*R2+CX,cos(BUF)*R2+CY
                if gettime(4)=(24-cnt):color CMAIN:else:color CSUB
                mes 24-cnt
        loop
        ;日
        repeat 31
                BUF=D31*(1.0*gettime(4)/24+gettime(3)+cnt)-D31/2
                pos sin(BUF)*R3+CX,cos(BUF)*R3+CY
                if gettime(3)=(31-cnt):color CMAIN:else:color CSUB
                mes 31-cnt
        loop
        ;月
        repeat 12
                BUF=D12*(1.0*gettime(3)/31+gettime(1)+cnt)-D12/2
                pos sin(BUF)*R4+CX,cos(BUF)*R4+CY
                if gettime(1)=(12-cnt):color CMAIN:else:color CSUB
                mes 12-cnt
        loop
        redraw 1
        wait 1
        goto *top

補足

ほとんど最適化されていない部分があるのは、面倒だったからに他ならない。

補足2

ふつうのアナログ時計は、SourceCodeHSPにあります。

FSWiki

codeプラグイン用HSP強調表示定義ファイル

FSWikiのプラグイン投稿ページの、BugTrack-plugin/208で公開されているcodeプラグインで使える、
HSPのソースコード強調表示用定義ファイルです。
HSP3.0のエディタで強調表示される命令/マクロ/ラベルなどが色分けで表示されます。プラグインやモジュールなどで追加された命令などは変化しません。

hsed3.exeの強調表示との違い

  • 複数行コメントの色分けに失敗しません。
  • 文字列(""で囲う部分)に含まれるダブルクオーテーションのエスケープに対応しています。

サンプル

上にあるHSPのソースコードがサンプルです。

現状での問題点と例

  • "int()"のように、文字列の中に命令や関数と同じ文字列があると色が変わってしまう。
  • 複数行コメントの最終行をコメントアウトしている場合の処理がおかしい。
1
2
3
4
5
6
7
8
9
        PI=3.1415926535
        mes "小数は自動で適当に丸められて表示されますが、"
        mes "strf()関数を用いて回避することが出来ます。\n"
        mes "PIの値は"+strf("%1.10f",PI)+"です。\n\n"
/*
        mes "strf()関数を使わない場合はこのようになります。\n"
        mes "PIの値は\""+PI+"\"です。\n"
//*/
        stop

本体

  • この本体は、新バージョンです。以前の問題点「""+Aのような文に対して色の変わる範囲がおかしい」と言う問題を修正しています。

HSP.pm(213)

  • [1]どこぞに転載して「俺が作った!」とか言われると泣きそうになるかもしれないけど…
HSP.pm

最終更新時間:2008年07月16日 22時22分31秒


TSUKABAN!への連絡の際には、こちらもお読みください。→TsProfile