◆ [VBScript] ラジオボタンダイアログを実現する その3
こんにチワワ。どーもボキです。

前回の記事 ⇒ [VBScript] ラジオボタンダイアログを実現する その2

ラジオボタンダイアログを改良した。タイトルバーに「http:/// -」を出なくした。

実行ソース
r = RadioGroupBox("タイトル","キャプション","アイテム0,アイテム1,アイテム2",1)
a0021757_21244099.gif
戻り値は、[OK]ボタンが押された場合は項目インデックス (0~)。
[キャンセル]ボタン や [×]で終了した場合は、-1。

RadioGroupBox_MaxCount = 3
とすることで、項目が指定数(この場合は3)以上になった場合、プルダウンメニュータイプに変更できる。
a0021757_21243675.gif







セキュリティの関係上、ocument、nClick に全角に変更している。
利用する場合は、半角文字に打ち直してほしい。

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

[PR]
by yozda | 2012-09-22 17:37 | プログラミング | Trackback(2) | Comments(10)
トラックバックURL : http://yozda.exblog.jp/tb/16263021
トラックバックする(会員専用) [ヘルプ]
Tracked from ( … > Z_ ̄∂ at 2012-09-22 18:07
タイトル : [VBScript] メッセージダイアログを実現する
こんにチワワ。ドーモボキです。 [VBScript] ラジオボタンダイアログを実現する その3... more
Tracked from ( … > Z_ ̄∂ at 2014-12-29 09:29
タイトル : [VBScript] ラジオボタンダイアログを実現する ..
おはヨーグルト。どーもボキです。 IE11でonclickを検出しない問題。解決した。 onclick=Button.Value=1 ⇒ onclick=Form.Button.Value=1 とすればいい。 RadioGroupBox_MaxCount = 10 r = RadioGroupBox(&quot;タイトル&quot;,&quot;キャプション&quot;,&quot;アイテム0,アイテム1,アイテム2&quot;,1) MsgBox r '------------...... more
Commented by 晶人 at 2014-07-16 16:07 x
大変参考になりました。
ただし、IEがプロセスに残り続けてメモリを消費するので
「End Function」の手前に
objIE.Quit
Set objIE = Nothing
を書き足して利用させていただいています。
Commented by yozda at 2014-07-16 17:17
晶人さん、コメント&助言ありがとうございます。
修正しておきます。
Commented by doraken at 2014-08-19 17:19 x
こんにちは。サンプルのコードをみてWindows8でがんばっているのですがIE11からonclickイベントが動作しないようでボタン表示まで来ているけど「OK」や「キャンセル」ボタンがききません。

HTML周りをいじれば良いと思われるのですが、どのように回避すべきか、いまいち理解できないのでIE11で動作できるように見直ししてもらえると嬉しいです。
Commented by yozda at 2014-08-19 20:23
dorakenさん、コメントありがとうございます。

申し訳ないですが、手元にWin8環境がないため、
すぐの検証&改善は難しいです。すこあし時間をください。
Commented at 2014-08-20 09:37 x
ブログの持ち主だけに見える非公開コメントです。
Commented by yozda at 2014-08-20 23:50
コメントで頂いたIE11でのトラブルですが、
://social.technet.microsoft.com/Forums/appvirtualization/ja-JP/46c9ba70-0045-424f-a60d-cfff5fd750a2/ie11inputsubmit?forum=internetexplorerja
に原因と解決策が書かれていると思われます。

すみませんが、ご確認いただけますでしょうか。
Commented by yozda at 2014-08-20 23:55
職場はIE8(自宅はIE7)のため、検証できていません。
あと、『http(半角)』をコメントへの禁止文字としているため、上記URLの冒頭から削除しています。webページ確認時に追記ください。
Commented by dorak at 2014-08-21 10:58 x
色々お手数をおかけして申し訳ありません。

紹介されたURLを確認して
<INPUT TYPE=BUTTON VALUE=""OK"" NAME=OK ・・・
にnameを設定してみましたが症状は変わりませんでした。もうひとつ最初の html= から始まるhtml生成部分に1行、metaタグを入れてIE8ドキュメントモードにも設定してみましたがダメでした。

シンプルなテストコードを作ってみて、自分でももう少し頑張ってみます。何か新しい発見があったら書き込みさせていただきます。
Commented by yozda at 2014-08-23 12:14
drakenさん、検証ありがとうございます。
私も原因調査継続しますので、何か分かりましたら書き込み等で連絡ください。

あと非公開コメントに記載のあったメルアドにメールしましたが、届かなかったようです。(darmonから帰ってきた)
Commented by yozda at 2014-12-29 09:33
dorakさん、ご無沙汰しております。解決しました。
onclick=Form.Button.Valueとすることで、Button.Valueに値を反映できました。
<< [VBScript] メッセー... ニンテンドウ64 >>