UWSCでシステムカーソルを変更する

UWSC公式掲示板で、マウスカーソルを一時的に変更する方法はないか、という質問があった。
ということで、変更するスクリプトを書いてみた。



スクリプト

SystemCursor.uws

OPTION EXPLICIT

IFB GET_UWSC_NAME = "SystemCursor.uws" THEN
	DIM sel, type, cursor
	TRY
		REPEAT
			sel = SLCTBOX(SLCT_BTN, 0, "動作選択", "既存カーソルで変更", "ファイルから変更", "透明化")
			type = -1
			IF sel <> -1 THEN type = SLCTBOX(SLCT_BTN OR SLCT_STR, 0, "変更対象", SystemCursor.TYPES)
			IFB type <> -1 THEN
				SELECT sel
				CASE SLCT_1
					cursor = SLCTBOX(SLCT_BTN OR SLCT_STR, 0, "使用カーソル(×は元に戻す)", SystemCursor.TYPES)
					IF cursor = -1 THEN cursor = NULL
					SystemCursor.Set(type, cursor)
				CASE SLCT_2
					cursor = INPUT("カーソルファイルを指定してください")
					IF cursor <> EMPTY THEN SystemCursor.Set(type, cursor)
				CASE SLCT_3
					SystemCursor.Set(type, 0)
				SELEND
			ENDIF
		UNTIL sel = -1
	FINALLY
		SystemCursor.Dispose()
	ENDTRY
ENDIF


MODULE SystemCursor

	// WinAPI
	DEF_DLL LoadCursorFromFileW(wstring): dword: user32
	DEF_DLL LoadCursorW(dword, dword): dword: user32
	DEF_DLL SetSystemCursor(dword, dword): bool: user32
	DEF_DLL CopyIcon(dword): dword: user32
	DEF_DLL DestroyCursor(dword): bool: user32
	DEF_DLL CreateCursor(dword, int, int, int, int, byte[], byte[]): dword: user32

	PUBLIC TYPES[] = "APPSTARTING", "ARROW", "CROSS", "HAND", "HELP", "IBEAM", "ICON", "NO", "SIZE", "SIZEALL", "SIZENESW", "SIZENS", "SIZENWSE", "SIZEWE", "UPARROW", "WAIT"
	CONST APPSTARTING = 32650
	CONST ARROW = 32512
	CONST CROSS = 32515
	CONST HAND = 32649
	CONST HELP = 32651
	CONST IBEAM = 32513
	CONST ICON = 32641
	CONST NO = 32648
	CONST SIZE = 32640
	CONST SIZEALL = 32646
	CONST SIZENESW = 32643
	CONST SIZENS = 32645
	CONST SIZENWSE = 32642
	CONST SIZEWE = 32644
	CONST UPARROW = 32516
	CONST WAIT = 32514

	HASHTBL CursorOriginal

	FUNCTION Set(type, cursor=NULL)
		RESULT = FALSE

		DIM typeType = VARTYPE(type), curType = VARTYPE(cursor)
		IFB typeType = VAR_ASTR OR typeType = VAR_USTR THEN
			TRY
				type = EVAL(type)
				typeType = VARTYPE(type)
			EXCEPT
				// 失敗は無視
			ENDTRY
		ENDIF
		IFB curType = VAR_ASTR OR curType = VAR_USTR THEN
			TRY
				cursor = EVAL(cursor)
				curType = VARTYPE(cursor)
			EXCEPT
				// 失敗は無視
			ENDTRY
		ENDIF

		DIM newCurh = 0, orgCurh = CopyIcon(LoadCursorW(0, type))
		IFB curType = VAR_ASTR OR curType = VAR_USTR THEN
			newCurh = LoadCursorFromFileW(cursor)
		ELSEIF cursor = NULL THEN
			IFB CursorOriginal[type, HASH_EXISTS] THEN
				newCurh = CursorOriginal[type]
				orgCurh = 0
				RESULT = CursorOriginal[type, HASH_REMOVE]
			ENDIF
		ELSEIF cursor = 0 THEN
			DIM am[127], xm[127]
			SETCLEAR(am, $FF)
			SETCLEAR(xm, 0)
			newCurh = CreateCursor(0, 0, 0, 32, 32, am, xm)
		ELSE
			newCurh = CopyIcon(LoadCursorW(0, cursor))
			IFB orgCurh = 0 OR newCurh = 0 THEN
				DestroyCursor(newCurh)
				newCurh = 0
			ENDIF
		ENDIF
		IFB newCurh <> 0 THEN
			RESULT = SetSystemCursor(newCurh, type)
			IFB RESULT AND !CursorOriginal[type, HASH_EXISTS] AND orgCurh <> 0 THEN
				CursorOriginal[type] = orgCurh
			ENDIF
		ENDIF
	FEND

	FUNCTION Dispose()
		RESULT = TRUE
		DIM i
		FOR i = LENGTH(CursorOriginal) - 1 TO 0 STEP -1
			RESULT = RESULT AND Set(CursorOriginal[i, HASH_KEY])
		NEXT
	FEND

ENDMODULE

解説

重要!
一時変更、ということはできません。
変更してしまうと、スクリプトを停止しても、変更されたままになります。
その弊害を避けるため、変更処理で元の状態を保持し、Dispose関数で戻すようにしています。


テストコードは全体を、TRY-FINALLYでくくって、なるべく最後にSystemCursor.Disposeが呼ばれるようにしています。
(中断のショートカットを二回連続で押されると、無力ですが、、、)


あとはまあ、テストコードを見てもらえればわかると思いますが、Set関数で変更しています。
第一引数が、対象のカーソル。
通常のカーソルは、「ARROW」ですね。
「ARROW」という名前でも、SystemCursor.ARROWの定義値でも動作します。


第二引数は、変更先。
こちらも第一引数同様、名前や数値を渡すと、それと同じものにします。
NULLもしくは省略した場合は、元に戻す。
0の場合は、透明化します。
また、カーソルファイルのパスを渡すと、それに変更します。


ARROWが通常の矢印なので、これを変更するとわかりやすいです。
が、これを透明にするとかなり難易度の高い状態になってしまうので、SIZENS(上下サイズ変更)とかを変更するのが無難です。


そんなところですね!