Dialog

ダイアログ機能説明

概要

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」ボタンのデフォルト設定は解除されます。