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

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

こん時のソース。IEをQuitしてなかったので、実行のたびにiexplore.exeが残ってしまってた。なので修正。

あとアイテムリストが指定数以上の場合は、プルダウンメニュー表示させる機能を追加した。
a0021757_1519732.gif
ラジオボックスで表示 (もともとの機能)


a0021757_151954.gif
上図は表示指定数=1とした場合。指定数=10とすると、画面上に10個は表示される。([∨]を押すと全項目が表示される)


それにしてもIEを使って実現しているから、実行は遅いよね。
すなおにInputBox使ったほうがストレスはないかもね。



'-----------------------------------------------------------------------------------------
' sTitle : タイトル
' sCaption : メッセージ
' RadioItems : ラジオアイテムリスト (配列)
' DefaultIndex : デフォルト選択するアイテムインデックス
RadioGroupBox_Height = 300
RadioGroupBox_Width = 400
RadioGroupBox_FontSize = 10
RadioGroupBox_MaxCount = 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"">"
If UBound(RadioItems) >= RadioGroupBox_MaxCount-1 Then
' コンボボックス
ieDoc.Write "<SELECT NAME=""Radio"" size=" & RadioGroupBox_MaxCount &" style=""width:100%;"">"
For i = 0 To UBound(RadioItems)
If i = DefaultIndex Then s = " selected" Else s = ""
ieDoc.Write "<OPTION value=""" & i & """" & s & ">" & RadioItems(i) &"</OPTION>"
Next
ieDoc.Write "</SELECT><BR>"
Else
' ラジオボタン
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
End If
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



'=========================================================================================
RItems = Array( _
"アイテム 0", _
"アイテム 1", _
"アイテム 2", _
"アイテム 3", _
"アイテム 4", _
"アイテム 5", _
"アイテム 6", _
"アイテム 7", _
"アイテム 8", _
"アイテム 9", _
"アイテム 10", _
"アイテム 11", _
"アイテム 12", _
"アイテム 13", _
"アイテム 14" _
)



RadioGroupBox_MaxCount = 1
r = RadioGroupBox("コンボボックステスト", "プルダウンメニューから選択してください", RItems, 3)

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



RadioGroupBox_Height = 450
RadioGroupBox_MaxCount = 20
r = RadioGroupBox("ラジオボックステスト", "ラジオアイテムから選択してください", RItems, 3)

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

[PR]
by yozda | 2011-03-09 15:21 | プログラミング | Trackback(1) | Comments(0)
トラックバックURL : http://yozda.exblog.jp/tb/12246492
トラックバックする(会員専用) [ヘルプ]
Tracked from ( … > Z_ ̄∂ at 2012-09-22 17:37
タイトル : [VBScript] ラジオボタンダイアログを実現する ..
こんにチワワ。どーもボキです。 [VBScript] ラジオボタンダイアログを実現する その2'----------------------------------------------------------------------------------------- ' sTitle : タイトル ' sCaption : メッセージ ' RadioItems : ラジオアイテムリスト (配列) ' DefaultIndex : デフォルト選択するアイテム...... more
<< 設備システムとのCAN通信、想... [英語学習] 千田潤一氏の講習... >>