ダイアログ機能説明
概要
AcadRemoconでは、独自のダイアログをコードから簡単に作成することが出来ます。
使用出来るすべてのコントロールを配置したダイアログを下に示します。
※「OK」ボタンと「キャンセル」ボタンは自動的に追加されます。それぞれのコントロール名は「cmdOK」と「cmdCancel」です。
基本的な使用例(VBScript)
↓コード
Set Acad = CreateObject("AcadRemocon.Body") Acad.dlLoad "ダイアログサンプル" 'ダイアログ開始 Acad.dlAddLabel "", "開始番号" Acad.dlAddText "txtStart", "123" Acad.dlShow 'ダイアログ表示 Do Acad.dlWaitEvent CtrlName 'イベント発生待ち Select Case CtrlName Case "cmdOK" Txt = Acad.dlGetProperty("txtStart", "Text") Exit Do Case "cmdCancel": Exit Do End Select Loop While True Acad.dlUnload 'ダイアログ終了 If CtrlName = "cmdOK" Then MsgBox "開始番号は「" & Txt & "」です。" |
↓実行イメージ
推奨コード(VBScript)
↓コード
特徴1)ダイアログ構築部をサブルーチン化し、メインルーチンの可読性を向上させています。
特徴2)イベント処理ルーチンを分け、コントロールの初期化処理にも使っています。
特徴3)エラールーチンにdlUnloadメソッドを記述し、エラーメッセージがダイアログの背面に隠れないようにしています。
Dim Acad Call Main Private Sub Main() 'AcadRemocon作成 Set Acad = CreateObject("AcadRemocon.Body") 'バージョンチェック If Not Acad.CheckVersion("200") Then Exit Sub 'ダイアログ作成&表示 DialogCreate '設定値取得 Acad.GetIniVal Keta, "Keta", "DialogSample" Acad.GetIniVal Colo, "Colo", "DialogSample" '初期値設定(値を設定後、イベントルーチンを呼び出してコントロールを初期化する) Acad.dlSetProperty "chkKeta", "Value", Keta Acad.dlSetProperty "lstColo", "ListIndex", Colo DialogEvent "chkKeta", Keta, -1 DialogEvent "lstColo", "", Colo 'イベント監視ループ Do 'イベント発生待ち Acad.dlWaitEvent CtrlName, CtrlValue, CtrlListIndex 'イベント処理 Select Case DialogEvent(CtrlName, CtrlValue, CtrlListIndex) Case vbOK: Exit Do Case vbCancel: Exit Sub End Select Loop While True 'コントロールの値取得(ダイアログのアンロード前に行う) Keta = Acad.dlGetProperty("chkKeta", "Value") Colo = Acad.dlGetProperty("lstColo", "ListIndex") 'ダイアログアンロード Acad.dlUnload '設定値保存 Acad.PutIni Keta, "Keta", "DialogSample" Acad.PutIni Colo, "Colo", "DialogSample" End Sub 'ダイアログ作成&表示 Sub DialogCreate() Acad.dlLoad "ダイアログサンプル" 'ダイアログ開始 Acad.dlAddCheck "chkKeta", "桁を揃える", Keta, 16, 1 Acad.dlIncCurrentX 4 Acad.dlAddLabel "", "桁数", 4, -1, True Acad.dlAddText "txtKeta", "0", 11, 4, True Acad.dlAddLabel "", "色", 16, 1 'アイテム値を利用して色名に対応した数値を格納 Acad.dlAddList "lstColo", "黒|赤|緑|黄|青|マゼンタ|シアン|白", 0, 16, 8, 0, "0|255|65280|65535|16711680|16711935|16776960|16777215" Acad.dlShow 'ダイアログ表示 End Sub 'ダイアログイベント処理 Function DialogEvent(CtrlName, CtrlValue, CtrlListIndex) 'コントロール名で区別 Select Case CtrlName 'OKボタン Case "cmdOK" '桁数に1以上の値が入っていればOK If Acad.dlGetValue("txtKeta") >= 1 Then DialogEvent = vbOK: Exit Function 'メッセージ表示 Acad.dlShowMessage "桁数には1以上の数値を入力して下さい", vbExclamation + vbOKOnly 'キャンセルボタン Case "cmdCancel": DialogEvent = vbCancel: Exit Function '桁揃えチェックボックス Case "chkKeta" '桁数テキストボックスの無効化 If CtrlValue = 0 Then Acad.dlSetProperty "txtKeta", "Enabled", False '桁数テキストボックスを有効化 Else Acad.dlSetProperty "txtKeta", "Enabled", True End If '色リストボックス Case "lstColo" 'アイテム値を取得 BC = Acad.dlGetProperty("lstColo", "ItemData", CtrlListIndex) '背景色と前景色を設定 Acad.dlSetProperty "lstColo", "BackColor", BC Acad.dlSetProperty "lstColo", "ForeColor", &HFFFFFF - BC End Select '再度イベント待ち DialogEvent = vbRetry End Function 'エラー処理 Sub Er() 'ユーザーによるキャンセル If Acad.ErrNumber = vbObjectError + 1000 Then 'ここにキャンセル時の処理を追加 Else 'エラー表示が隠れないようにダイアログアンロード Acad.dlUnload 'エラー内容表示 Acad.ShowError End If End Sub |
↓実行イメージ
動作1)色を選択すると、リストボックスの背景色が選択した色と同じになります。
動作2)「桁を揃える」チェックボックスのチェックを外すと、「桁数」テキストボックスの背景色がグレーになり編集不可になります。
動作3)「桁数」テキストボックスに1以下の数値を入力して「OK」をクリックするとエラーメッセージを表示します。
動作4)正常終了時に「桁を揃える」チェックボックスと「色」リストボックスの状態を保存します。
ちょっとテクニックを使ったコード(VBScript)
↓実行イメージ
テク1)dlCallMethodを使って、リストボックスに動的にプレビューを表示させています。
テク2)「OK」ボタンを非表示にし、「キャンセル」ボタンを「終了」に書き換えています。
テク3)改行量は一番右端のコントロールの値が採用されることと、幅が0のコントロールは非表示になることを利用してコントロールを2列に配置しています。
↓コード
Dim Acad Call Main Private Sub Main() 'AcadRemocon作成 Set Acad = CreateObject("AcadRemocon.Body") 'バージョンチェック If Not Acad.CheckVersion("200") Then Exit Sub 'ダイアログ作成&表示 DialogCreate 'コントロールの初期値でプレビュー実行 DialogEvent "txtStart", "", -1 'イベント監視ループ Do 'イベント発生待ち Acad.dlWaitEvent CtrlName, CtrlValue, CtrlListIndex 'イベント処理 If DialogEvent(CtrlName, CtrlValue, CtrlListIndex) = vbCancel Then Exit Sub Loop While True 'ダイアログアンロード Acad.dlUnload End Sub 'ダイアログ作成&表示 Sub DialogCreate() Acad.dlLoad "プレビューサンプル" 'ダイアログ開始 Acad.dlAddLabel "", "開始値", 12, -1 Acad.dlAddLabel "", "プレビュー", 12, 1 Acad.dlAddText "txtStart", "1", 10, -1, True Acad.dlIncCurrentX 8 Acad.dlAddList "lstPrev", "", 0, 16, 12, -1 Acad.dlSetProperty "lstPrev", "TabStop", False 'Tabによるフォーカス移動を無効に Acad.dlAddText "", "", 0 '改行のためのダミーコントロール Acad.dlAddLabel "", "終了値", 12, 1 Acad.dlAddText "txtEnd", "5", 10, 4, True Acad.dlSetProperty "cmdOK", "Visible", False Acad.dlSetProperty "cmdCancel", "Text", "終了" Acad.dlShow 'ダイアログ表示 End Sub 'ダイアログイベント処理 Function DialogEvent(CtrlName, CtrlValue, CtrlListIndex) 'コントロール名で区別 Select Case CtrlName 'キャンセルボタン Case "cmdCancel": DialogEvent = vbCancel: Exit Function 'テキストボックス Case "txtStart", "txtEnd" '開始値と終了値を得る ST = Acad.vbVal(Acad.dlGetProperty("txtStart", "Text")) ED = Acad.vbVal(Acad.dlGetProperty("txtEnd", "Text")) 'プレビュー開始 Cnt = 0 Acad.dlCallMethod "lstPrev", "Clear" For i = ST To ED Cnt = Cnt + 1 If i = ED Or Cnt < 9 Then Acad.dlCallMethod "lstPrev", "AddItem", i ElseIf Cnt = 9 Then Acad.dlCallMethod "lstPrev", "AddItem", "途中省略・・・" End If Next '最後の項目を選択 Acad.dlSetProperty "lstPrev", "ListIndex", Acad.dlGetProperty("lstPrev", "ListCount") - 1 End Select '再度イベント待ち DialogEvent = vbRetry End Function 'エラー処理 Sub Er() 'ユーザーによるキャンセル If Acad.ErrNumber = vbObjectError + 1000 Then 'ここにキャンセル時の処理を追加 Else 'エラー表示が隠れないようにダイアログアンロード Acad.dlUnload 'エラー内容表示 Acad.ShowError End If End Sub |
補足(Enterキーの扱い)
通常は「OK」ボタンがデフォルトボタンにしてありますので、フォーカスがどのコントロールにあっても「Enterキー押し下げ」=「OKボタンクリック」になります。
ただしマルチラインテキストを1個でも配置した場合は「OK」ボタンのデフォルト設定は解除されます。
また「dlLoad」メソッドの「TabByEnter」引数をTrueにした場合、Enterキーはテキストボックス間のフォーカス移動になりますので、同じく「OK」ボタンのデフォルト設定は解除されます。