[VBScript] ラジオボタンダイアログを実現する その3
2012年 09月 22日
実行ソース
r = RadioGroupBox("タイトル","キャプション","アイテム0,アイテム1,アイテム2",1)
[キャンセル]ボタン や [×]で終了した場合は、-1。
RadioGroupBox_MaxCount = 3
とすることで、項目が指定数(この場合は3)以上になった場合、プルダウンメニュータイプに変更できる。セキュリティの関係上、Document、onClick に全角に変更している。
利用する場合は、半角文字に打ち直してほしい。
RadioGroupBoxソース
'-----------------------------------------------------------------------------------------
' sTitle : タイトル
' sCaption : メッセージ
' RadioItems : ラジオアイテムリスト (配列)
' DefaultIndex : デフォルト選択するアイテムインデックス
RadioGroupBox_MaxCount = 10
Function RadioGroupBox(sTitle, sCaption, RadioItems, DefaultIndex)
Dim objIE,ieDoc,disp_h,disp_w
Dim i,s,r,html,bCmbBx
r = -1
If Not IsArray(RadioItems) Then RadioItems = Split(RadioItems,",")
' IEを起動
Set objIE = WScript.CreateObject("InternetExplorer.Application")
objIE.Navigate "about:blank"
' タグ記述
html = "<BODY><TABLE ID=Tbl BORDER=0 STYLE=font-size:10pt>" & _
"<TR><TD ALIGN=Left VALIGN=Top><SPAN>" & Replace(sCaption,vbCRLF,"<BR>") & "</SPAN>" & _
"<FORM NAME=Form>" & _
"<INPUT TYPE=HIDDEN NAME=Button VALUE=-1>"
bCmbBx = UBound(RadioItems) >= RadioGroupBox_MaxCount-1
If bCmbBx Then
' コンボボックス
html = html +"<SELECT NAME=ComboBox size=" & RadioGroupBox_MaxCount &" style=width:100%>"
For i = 0 To UBound(RadioItems)
If i = DefaultIndex Then s = " selected" Else s = ""
html = html +"<OPTION value=" & i & s & ">" & RadioItems(i) &"</OPTION>"
Next
s = s+"</SELECT>"
Else
' ラジオボタン
html = html +"<INPUT NAME=Radio TYPE=HIDDEN VALUE="& DefaultIndex & ">"
For i = 0 to UBound(RadioItems)
If i = DefaultIndex Then s = " checked" Else s = ""
html = html +" <INPUT TYPE=RADIO Name=RG onclick=Radio.value=" & i & s & ">" & RadioItems(i) &"</INPUT><BR>"
Next
End If
html = html +"<BR></TD></TR><TR><TD ALIGN=Center VALIGN=Bottom>"&_
"<INPUT TYPE=BUTTON VALUE="" OK "" onclick=Form.Button.value=1> " & _
"<INPUT TYPE=BUTTON VALUE=""キャンセル"" onclick=Form.Button.value=0;Radio.value=-1>" & _
"</TD></TR></FORM></TABLE></BODY>"
' ↓↓共通↓↓
objIE.Document.Body.InnerHtml = html
objIE.Document.Title = sTitle
Call GetResolution(disp_h, disp_w) ' 解像度取得
objIE.Toolbar = 0 ' 上ツールバーを隠す
objIE.StatusBar = False ' 下ステータスバーを隠す
objIE.Document.Body.RuntimeStyle.OverflowX = "hidden" ' 横 スクロールバーを隠す
objIE.Document.Body.RuntimeStyle.OverflowY = "hidden" ' 縦 〃
objIE.Width = objIE.Document.All.Tbl.clientWidth +50 ' 幅 サイズ調整
objIE.Height = objIE.Document.All.Tbl.clientHeight +70 ' 高 〃
objIE.Left = Int((disp_w -objIE.Width )/2) ' 左 位置調整
objIE.Top = Int((disp_h -objIE.Height)/2) ' 上 〃
For i = 0 To objIE.Width
objIE.Document.Title = objIE.Document.Title +" " ' - Microsoft Internet Explorerを隠す
i = i +10
Next
objIE.Document.Body.bgcolor = "ButtonFace" ' 色
objIE.Visible = True ' ウィンドウ表示
objIE.Resizable = False ' ウィンドウサイズ固定 ※表示前に実行すると縁にゴミ画像が残る
' ユーザ操作取得
On Error Resume Next ' エラー無視 ([×]終了対応)
Set ieDoc = objIE.Document
Do While r = -1
WScript.Sleep 100
r = CInt(ieDoc.Form.Button.value)
If objIE = Null Then Exit Do
Loop
objIE.Visible = False
' ↑↑共通↑↑
' 値取得
If bCmbBx Then
If CInt(ieDoc.Form.Button.value) = 1 Then
r = ieDoc.Form.ComboBox.selectedIndex
Else
r = -1
End If
Else
r = CInt(ieDoc.Form.Radio.value) ' 取得データは文字のため
End If
RadioGroupBox = r
objIE.Quit
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
ただし、IEがプロセスに残り続けてメモリを消費するので
「End Function」の手前に
objIE.Quit
Set objIE = Nothing
を書き足して利用させていただいています。
修正しておきます。
HTML周りをいじれば良いと思われるのですが、どのように回避すべきか、いまいち理解できないのでIE11で動作できるように見直ししてもらえると嬉しいです。
://social.technet.microsoft.com/Forums/appvirtualization/ja-JP/46c9ba70-0045-424f-a60d-cfff5fd750a2/ie11inputsubmit?forum=internetexplorerja
に原因と解決策が書かれていると思われます。
すみませんが、ご確認いただけますでしょうか。
あと、『http(半角)』をコメントへの禁止文字としているため、上記URLの冒頭から削除しています。webページ確認時に追記ください。
紹介されたURLを確認して
<INPUT TYPE=BUTTON VALUE=""OK"" NAME=OK ・・・
にnameを設定してみましたが症状は変わりませんでした。もうひとつ最初の html= から始まるhtml生成部分に1行、metaタグを入れてIE8ドキュメントモードにも設定してみましたがダメでした。
シンプルなテストコードを作ってみて、自分でももう少し頑張ってみます。何か新しい発見があったら書き込みさせていただきます。
私も原因調査継続しますので、何か分かりましたら書き込み等で連絡ください。
あと非公開コメントに記載のあったメルアドにメールしましたが、届かなかったようです。(darmonから帰ってきた)
onclick=Form.Button.Valueとすることで、Button.Valueに値を反映できました。