UWSCのSLCTBOXを複数行にしてみる

こんぴーた UWSC

公式掲示板にSLCTBOXを複数行にする方法はないか、というのがあったので、考えてみた。


考えた結果としては、、、

スクリプト

「CONST COL_NUM = 3」として3列固定にしています。
要素数とかから算出しなおしたいなら、COL_NUM参照しているあたりの修正が必要。
「CONST IE_WIDTH = 300」として、幅の最小値を300pxにしています。


SelectBox.uws

OPTION EXPLICIT

IFB GET_UWSC_NAME = "SelectBox.uws" THEN
	// サンプルデータ
	HASHTBL sample
	DIM i
	FOR i = 0 TO 25
		sample[i] = "項目" + i
	NEXT
	PRINT SelectBox(SLCT_RDO OR SLCT_NUM, 0, "Radio NUM 0", sample)
	PRINT SelectBox(SLCT_RDO OR SLCT_STR, 0, "Radio STR 0", sample)
	PRINT SelectBox(SLCT_RDO OR SLCT_NUM, 1, "Radio NUM 1", sample)
	PRINT SelectBox(SLCT_RDO, 0, "Radio - 0", sample)
	PRINT SelectBox(SLCT_CHK, 0, "Check - 0", sample)
	PRINT SelectBox(SLCT_CMB, 0, "Combo - 0", sample)
	PRINT SelectBox(SLCT_LST, 0, "ListB - 0", sample)
ENDIF


FUNCTION SelectBox(type, to, msg, list[], x=ERR_VALUE, y=ERR_VALUE)
	CONST COL_NUM = 3
	CONST MAX_SCROLL = 9999
	CONST IE_WIDTH = 300

	// html組立
	DIM i, html = "<html><head><title>UWSC - " + GET_UWSC_NAME + "</title></head><body>" + msg + "<br><table id=htmltable><tr>", rec = "<td><input type=###TYPE### name=htmlselect id=###ID###><label for=###ID###>###STR###</label></td>", sep = "</tr><tr>"
	SELECT TRUE
		CASE (type AND SLCT_RDO) > 0
			rec = REPLACE(rec, "###TYPE###", "radio")
		CASE (type AND SLCT_CHK) > 0
			rec = REPLACE(rec, "###TYPE###", "checkbox")
		DEFAULT
			// 未実装はオリジナルに投げて終了
			RESULT = SLCTBOX(type, to, msg, list)
			EXIT
	SELEND
	FOR i = 0 TO LENGTH(list) - 1
		IF i MOD COL_NUM = 0 THEN html = html + sep
		html = html + REPLACE(REPLACE(rec, "###STR###", list[i]), "###ID###", "htmlsel" + i)
	NEXT
	html = html + "</tr><tr><td align=center colspan=" + COL_NUM + "><input type=checkbox id=htmlok><label for=htmlok>OK</label></td></tr></table></body></html>"

	// html生成
	DIM path = GET_CUR_DIR + "\" + GET_UWSC_NAME + ".html"
	DIM f = FOPEN(path, F_WRITE)
	FPUT(f, html, F_ALLTEXT)
	FCLOSE(f)

	// 表示
	DIM ie = CREATEOLEOBJ("InternetExplorer.Application")
	ie.StatusBar = FALSE
	ie.AddressBar = FALSE
	ie.ToolBar = FALSE
	ie.Navigate("file://" + path)
	WHILE ie.Busy AND ie.readyState <> 4
		SLEEP(0.2)
	WEND
	ie.Visible = TRUE
	IF x <> ERR_VALUE THEN ie.Left = x
	IF y <> ERR_VALUE THEN ie.Top = y
	ie.Width = IE_WIDTH
	ie.Height = 0
	ie.document.body.scrollTop = MAX_SCROLL
	ie.document.body.scrollLeft = MAX_SCROLL
	WHILE ie.document.body.scrollTop > 0
		ie.Height = ie.Height + ie.document.body.scrollTop
	WEND
	WHILE ie.document.body.scrollLeft > 0
		ie.Width = ie.Width + ie.document.body.scrollLeft
	WEND

	// 選択チェック
	DIM ret = "", rads, end = GETTIME() + to, res = 0
	rads = ie.document.getElementById("htmlok")
	WHILE res <= 0 AND (to <= 0 OR end >= GETTIME())
		TRY
			IF rads.checked THEN res = 1
		EXCEPT
			res = -1
			BREAK
		ENDTRY
		SLEEP(0.1)
	WEND
	IFB res > 0 THEN
		rads = ie.document.getElementsByName("htmlselect")
		FOR i = 0 TO rads.length - 1
			IFB rads.item[i].checked THEN
				IFB (type AND SLCT_NUM) > 0 THEN
					IF LENGTH(ret) > 0 THEN ret = ret + "<#TAB>"
					ret = ret + i
				ELSEIF (type AND SLCT_STR) > 0 THEN
					IF LENGTH(ret) > 0 THEN ret = ret + "<#TAB>"
					ret = ret + list[i]
				ELSE
					IF LENGTH(ret) = 0 THEN ret = 0
					res = 1
					end = i
					WHILE end > 0
						res = res * 2
						end = end - 1
					WEND
					ret = ret + res
				ENDIF
			ENDIF
		NEXT
	ELSEIF res = -1 OR ((type AND (SLCT_NUM OR SLCT_STR)) = 0) THEN
		ret = res
	ENDIF

	// 終了
	COM_ERR_IGN
		ie.Quit()
	COM_ERR_RET
	DIM fso = CREATEOLEOBJ("Scripting.FileSystemObject")
	fso.DeleteFile(path)

	RESULT = ret
FEND

ま、とりあえずはこんなところです。