人気ブログランキング | 話題のタグを見る

[VBScript] ラジオボタンダイアログを実現する

どーもボキです。


より改良したものはこちら

VBScript(WSH)には、ユーザインターフェースと呼べるもんがほとんどない。
ユーザ入力画面といえば、InputBox か MsgBox くらい。
InputBox関数を使えばある程度の情報を入力させることが出来るが、せめてラジオボタンでの選択画面くらいはほしいもの。

VBScript単体での実現は無理だが、
VBScriptで作成したIEオブジェクトを利用すれば、ラジオボタンダイアログが実現できる。

ソースもアップしたかったが、エキサイトブログは、onclick や <Form>があると投稿できんし、
<INPUT>があると、オブジェクトが表示されるから、あきらめた。

くわしくはソース参照。IEオブジェクト作って、それにラジオボタン表示して、ユーザの操作結果を取得してるだけ。
RItems = Array( _
"ラジオボタンのタイトル 1", _
"ラジオボタンのタイトル 2", _
"ラジオボタンのタイトル 3", _
"ラジオボタンのタイトル 4", _
"ラジオボタンのタイトル 5" _
)


' 関数実行
' Function RadioGroupBox(sTitle, sCaption, RadioItems, DefaultIndex)
' sTitle : タイトル
' sCaption : メッセージ
' RadioItems : ラジオアイテムリスト (配列)
' DefaultIndex : デフォルト選択するアイテムインデックス
r = RadioGroupBox("タイトル", "キャプション", RItems, 0)

WScript.Echo "インデックス = " & r

[VBScript] ラジオボタンダイアログを実現する_a0021757_23513681.gif
実行イメージ

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

by yozda | 2010-01-16 23:51 | プログラミング | Comments(0)