[VBScript] ラジオボタンダイアログを実現する
2010年 01月 16日
より改良したものはこちら。
VBScript(WSH)には、ユーザインターフェースと呼べるもんがほとんどない。
ユーザ入力画面といえば、InputBox か MsgBox くらい。
InputBox関数を使えばある程度の情報を入力させることが出来るが、せめてラジオボタンでの選択画面くらいはほしいもの。
VBScript単体での実現は無理だが、
VBScriptで作成したIEオブジェクトを利用すれば、ラジオボタンダイアログが実現できる。
ソースもアップしたかったが、エキサイトブログは、onclick や <Form>があると投稿できんし、
<INPUT>があると、オブジェクトが表示されるから、あきらめた。
RItems = Array( _
"ラジオボタンのタイトル 1", _
"ラジオボタンのタイトル 2", _
"ラジオボタンのタイトル 3", _
"ラジオボタンのタイトル 4", _
"ラジオボタンのタイトル 5" _
)
' 関数実行
' Function RadioGroupBox(sTitle, sCaption, RadioItems, DefaultIndex)
' sTitle : タイトル
' sCaption : メッセージ
' RadioItems : ラジオアイテムリスト (配列)
' DefaultIndex : デフォルト選択するアイテムインデックス
r = RadioGroupBox("タイトル", "キャプション", RItems, 0)
WScript.Echo "インデックス = " & r
IEオブジェクトを使えば、大抵のユーザインターフェースをIE側で作れるだろね。
けど、これ以上複雑なもんは、DelphiやらCやら専用開発環境で作ったほうがいいと思う。
HTA(HTML アプリケーション)の知識も要るし。スクリプト言語で複雑な処理したいがために、HTAやらを調べ上げるのってムダじゃないかな。
スクリプト処理って、シンプルに作れてなんぼだと思うわ。
ソースを掲載。
onclickのo(全角)は、o(半角)にして。onclickは掲載できんかったから。
'-----------------------------------------------------------------------------------------
' sTitle : タイトル
' sCaption : メッセージ
' RadioItems : ラジオアイテムリスト (配列)
' DefaultIndex : デフォルト選択するアイテムインデックス
RadioGroupBox_Height = 300
RadioGroupBox_Width = 400
RadioGroupBox_FontSize = 10
Function RadioGroupBox(sTitle, sCaption, RadioItems, DefaultIndex)
Dim objIE,ieDoc,h,w
Dim i,s
RadioGroupBox = -1
' 解像度の取得
Call GetResolution(h,w)
' IEを起動
Set objIE = WScript.CreateObject("InternetExplorer.Application")
objIE.Toolbar = 0
objIE.Height = RadioGroupBox_Height
objIE.Width = RadioGroupBox_Width
objIE.Left = Int((w - objIE.Width)/2)
objIE.Top = Int((h - objIE.Height)/2)
objIE.Navigate "about:blank"
' タグ記述
Set ieDoc = objIE.Document
ieDoc.Write "<TITLE>" & sTitle & "</TITLE>"
ieDoc.Write "<BODY STYLE=overflow-y:hidden BGColor=ButtonFace>"
ieDoc.Write "<TABLE WIDTH=100% HEIGHT=100% BORDER=0 STYLE=font-size:" & RadioGroupBox_FontSize & "pt><TR><TD ALIGN=Left VALIGN=Top>"
ieDoc.Write "<SPAN>" & Replace(sCaption,vbCRLF,"<BR>") & "</SPAN>"
ieDoc.Write "<FORM NAME=""Form"">"
ieDoc.Write "<INPUT TYPE=HIDDEN NAME=""Button"" VALUE=""0"">"
ieDoc.Write "<INPUT TYPE=HIDDEN NAME=""Radio"" VALUE="""& DefaultIndex &""">"
For i = 0 to UBound(RadioItems)
If i = DefaultIndex Then s = "checked" Else s = ""
ieDoc.Write " <INPUT TYPE=RADIO Name=""RG"" onclick=""Radio.value=" & i & """" & s & ">" & RadioItems(i) &"</INPUT><BR>"
Next
ieDoc.Write "</TD></TR><TR><TD ALIGN=Center VALIGN=Bottom>"
ieDoc.Write "<INPUT TYPE=BUTTON VALUE="" OK "" onclick=""Form.Button.value=1""> "
ieDoc.Write "<INPUT TYPE=BUTTON VALUE=""キャンセル"" onclick=""Form.Button.value=2;Radio.value=-1"">"
ieDoc.Write "</FORM></TABLE></BODY>"
objIE.Visible = True
On Error Resume Next 'エラー無視 (ウィンドウの[×]終了対応)
' ユーザ操作取得
i = 0
Do While i = 0
WScript.Sleep 100
i = Int(ieDoc.Form.Button.value)
If objIE = Null Then Exit Do
Loop
objIE.Visible = False
RadioGroupBox = Int(ieDoc.Form.Radio.value) ' 取得データは文字のため
objIE.Quit ' IEを終了
Set objIE = Nothing
On Error GoTo 0 'エラー無視を解除
End Function
'-----------------------------------------------------------------------------------------
' 解像度を取得
Sub GetResolution(ByRef wHeight, ByRef wWidth)
Dim Locator,Service,OfeSet
Set Locator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set Service = Locator.ConnectServer
Set QfeSet = Service.ExecQuery("Select * From Win32_VideoController")
For Each Qfe In QfeSet
If Qfe.CurrentHorizontalResolution <> nil then ' 複数ディスプレイ出力PC対応
wWidth = Qfe.CurrentHorizontalResolution
wHeight= Qfe.CurrentVerticalResolution
End If
Next
End Sub