DOS/V Power Report 1997 January/VPR9701A.ISO/PROJ95/EXAMPLES/BATCH/MAIN.FRM

Text File | 1996-08-21 | 36KB | 866 lines

VERSION 2.00
Begin Form frmMain
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ﾊﾞｯﾁ印刷"
   ClientHeight    =   2940
   ClientLeft      =   1965
   ClientTop       =   2940
   ClientWidth     =   6030
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "ＭＳ Ｐゴシック"
   FontSize        =   9
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   ForeColor       =   &H00000000&
   Height          =   3345
   Left            =   1905
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2940
   ScaleWidth      =   6030
   Top             =   2595
   Width           =   6150
   Begin CommonDialog dlgCommon
      Left            =   3615
      Top             =   240
   End
   Begin PictureBox picSeparator
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   30
      Left            =   3375
      ScaleHeight     =   0
      ScaleWidth      =   2505
      TabIndex        =   14
      TabStop         =   0   'False
      Top             =   2250
      Width           =   2535
   End
   Begin CommandButton cmdSave
      Caption         =   "保存(&S)..."
      Enabled         =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   330
      Left            =   4665
      TabIndex        =   5
      Top             =   2430
      Width           =   1205
   End
   Begin CommandButton cmdOpen
      Caption         =   "開く(&O)..."
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   330
      Left            =   3405
      TabIndex        =   4
      Top             =   2430
      Width           =   1205
   End
   Begin SSPanel pnlBatches
      BevelOuter      =   1  'Inset
      Caption         =   "Panel3D1"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   1440
      Left            =   135
      TabIndex        =   7
      Top             =   360
      Width           =   3135
      Begin ListBox lstBatches
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   1110
         Left            =   20
         Sorted          =   -1  'True
         TabIndex        =   8
         Top             =   15
         Width           =   3105
      End
   End
   Begin CommandButton cmdEdit
      Caption         =   "編集(&E)..."
      Enabled         =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   330
      Left            =   3405
      TabIndex        =   2
      Top             =   1770
      Width           =   1205
   End
   Begin CommandButton cmdDelete
      Caption         =   "削除(&D)..."
      Enabled         =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   330
      Left            =   4665
      TabIndex        =   3
      Top             =   1755
      Width           =   1205
   End
   Begin CommandButton cmdNew
      Caption         =   "作成(&N)..."
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   330
      Left            =   3405
      TabIndex        =   0
      Top             =   1350
      Width           =   1205
   End
   Begin CommandButton cmdCopy
      Caption         =   "ｺﾋﾟｰ(&C)..."
      Enabled         =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   330
      Left            =   4665
      TabIndex        =   1
      Top             =   1320
      Width           =   1205
   End
   Begin CommandButton cmdClose
      Cancel          =   -1  'True
      Caption         =   "閉じる(&L)"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   330
      Left            =   4665
      TabIndex        =   13
      Top             =   690
      Width           =   1205
   End
   Begin CommandButton cmdPrint
      Caption         =   "印刷(&P)"
      Default         =   -1  'True
      Enabled         =   0   'False
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   330
      Left            =   4665
      TabIndex        =   12
      Top             =   255
      Width           =   1205
   End
   Begin SSFrame fraProjectOpt
      Caption         =   "印刷対象"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   885
      Left            =   135
      TabIndex        =   9
      Top             =   1920
      Width           =   3150
      Begin SSOption optWhichProjects
         Caption         =   "作業中のﾌﾟﾛｼﾞｪｸﾄのみ(&V)"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   285
         Index           =   0
         Left            =   180
         TabIndex        =   10
         Top             =   225
         Value           =   -1  'True
         Width           =   2835
      End
      Begin SSOption optWhichProjects
         Caption         =   "すべての開いたﾌﾟﾛｼﾞｪｸﾄ(&A)"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   285
         Index           =   1
         Left            =   180
         TabIndex        =   11
         TabStop         =   0   'False
         Top             =   510
         Width           =   2835
      End
   End
   Begin Label lblBatches
      BackColor       =   &H00C0C0C0&
      Caption         =   "印刷ﾊﾞｯﾁ(&B):"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   240
      Left            =   165
      TabIndex        =   6
      Top             =   120
      Width           =   1275
   End
End
Option Explicit
Option Base 1

Dim mbCancelSave As Integer     '保存のダイアログがキャンセルされたかどうかを示すフラグ

Sub cmdClose_Click ()
'このプロシージャは、バッチ ファイルを保存するかどうかをユーザーに
'確認し、アプリケーションを閉じます。

Dim nReply As Integer       'メッセージ ボックスでクリックされたボタンの値

    If gbNeedSave Then
        nReply = MsgBox(MB_QUERYSAVE, MB_YESNOCANCEL + MB_ICONQUESTION, MB_QUERYSAVE_TITLE)
        Select Case nReply
            Case IDCANCEL                   'ユーザーが [キャンセル] をクリックした場合
                Exit Sub
            Case IDYES                      'ユーザーが [はい] (変更を保存) をクリックした場合
                cmdSave_Click               '保存のプロシージャを呼び出します。
                If mbCancelSave Then        'ユーザーが保存のプロシージャをキャンセルした場合
                    mbCancelSave = False    'フラグをリセットします。
                    Exit Sub                'プログラムを閉じずにサブルーチンを終了します。
                Else
                    End                     'プログラムを閉じます。
                End If
            Case IDNO                       'ユーザーが [いいえ] (変更を保存せずに終了) をクリックした場合
                End                         'プログラムを閉じます。
        End Select
    Else
        End                                 'アプリケーションを閉じます。
    End If

End Sub

Sub cmdCopy_Click ()
'このプロシージャは、コピーしたバッチの値を [バッチの定義] フォームに
'入力し、さらにフォームを表示します。

Dim iSearchVal As Integer   'バッチ名の検索で返された値
Dim iSelBatch As Integer    'gabtBatches() で現在選択されているバッチのインデックス

    MousePointer = HOURGLASS

    If bSetActiveProjObj() = False Then     '作業中のプロジェクトのオブジェクトを取得できない場合
        MsgBox MB_NO_ACTIVEPROJECT, MB_ICONEXCLAMATION, MB_NO_ACTIVEPROJECT_TITLE
        frmBatchDef.Hide    '[バッチの定義] フォームを非表示にします。
        MousePointer = DEFAULT
        Exit Sub
    End If

    If lstBatches.ListCount = MAX_BATCHES Then  'これ以上バッチを追加できません。
        MsgBox MB_MAX_BATCHES, MB_ICONEXCLAMATION, MB_MAX_BATCHES_TITLE
        MousePointer = DEFAULT
        Exit Sub
    End If

    gbNeedSave = True       '保存が必要であることを示します。

    '[バッチの定義] フォームのフィールドを、選択されているバッチに設定します。
    iSelBatch = lstBatches.ItemData(lstBatches.ListIndex)
    SetBatchDef iSelBatch, BATCH_COPY

    Do
        MousePointer = DEFAULT

        '[バッチの定義] フォームを表示します。
        frmBatchDef.Show MODAL

        iSearchVal = iSearchBatchName(gbtBatchBfr.Name)
        If iSearchVal <> -1 Then    '同じ名前のバッチが既に存在する場合
            MsgBox MB_DUPLICATE_NAME, MB_ICONEXCLAMATION, MB_DUPLICATE_NAME_TITLE
        End If

    Loop Until iSearchVal = -1

    If gbtBatchBfr.Name <> "ｷｬﾝｾﾙ" Then            'バッファには新しいバッチ情報が含まれます。
        gnNumOfBatches = gnNumOfBatches + 1         'バッチのカウントを 1 つインクリメントします。
        gabtBatches(gnNumOfBatches) = gbtBatchBfr   '新しいバッチを配列に格納します。
        lstBatches.AddItem gbtBatchBfr.Name         '一覧に名前を追加します。
        'gabtBatches の位置を保存します。
        lstBatches.ItemData(lstBatches.NewIndex) = gnNumOfBatches
        lstBatches.ListIndex = lstBatches.NewIndex  '一覧から新しいバッチを選択します。
    End If

End Sub

Sub cmdDelete_Click ()
'このプロシージャは、選択されているバッチを gabtBatches() から削除し、
'その名前を [印刷バッチ] ボックスから削除します。
'バッチを削除すると、gabtBatches() 配列の末尾のバッチが
'削除したバッチの位置へ移動し、配列の空所が埋められます。

Dim iDelPos As Integer      '削除するバッチの gabtBatches() での位置
Dim iListPos As Integer     'gabtBatches() の末尾にあるバッチの lstBatches の位置

    '削除を確認します。
    If MsgBox(lstBatches.Text + MB_DELETE, MB_YESNO + MB_ICONQUESTION, MB_DELETE_TITLE) = IDNO Then
        Exit Sub    '削除をキャンセルします。
    End If

    gbNeedSave = True       '保存が必要であることを示します。

    '削除したバッチの gabtBatches() での位置を保存します。
    iDelPos = lstBatches.ItemData(lstBatches.ListIndex)

    '配列の末尾のバッチを、削除したバッチの位置へ移動します。
    gabtBatches(iDelPos) = gabtBatches(gnNumOfBatches)

    'バッチ数を 1 つ減らします。
    gnNumOfBatches = gnNumOfBatches - 1

    'lstBatches で移動したバッチの位置を検索します。
    iListPos = iSearchBatchName(gabtBatches(iDelPos).Name)

    'ItemData を更新して、バッチの新しい位置を参照させます。
    lstBatches.ItemData(iListPos) = iDelPos

    '削除したバッチの名前を一覧から削除します。
    lstBatches.RemoveItem lstBatches.ListIndex

    '現在の選択対象を一覧から削除すると、一覧の項目は何も
    '選択されていない状態になります。これを避けるために、
    '削除の後で一覧の先頭にある項目を選択します。
    If gnNumOfBatches > 0 Then lstBatches.ListIndex = 0

    If gnNumOfBatches = 0 Then              '一覧から末尾のバッチを削除します。
        cmdEdit.Enabled = False             '[編集] ボタンを無効にします。
        cmdCopy.Enabled = False             '[コピー] ボタンを無効にします。
        cmdDelete.Enabled = False           '[削除] ボタンを無効にします。
        cmdSave.Enabled = False             '[保存] ボタンを無効にします。
        cmdPrint.Enabled = False            '[印刷] ボタンを無効にします。
    End If

End Sub

Sub cmdEdit_Click ()
'このプロシージャは、選択されているバッチの情報を [バッチの定義] フォームの
'フィールドに読み込んで、フォームを実行します。

Dim iSelBatch As Integer    'gabtBatches() で現在選択されているバッチのインデックス
Dim iSearchVal As Integer   'バッチ名の検索で返される値
Dim sOrigName As String     '(編集の前に) 元のバッチ名を保存します。

    MousePointer = HOURGLASS

    If bSetActiveProjObj() = False Then     '作業中のプロジェクトのオブジェクトを取得できない場合
        MsgBox MB_NO_ACTIVEPROJECT, MB_ICONEXCLAMATION, MB_NO_ACTIVEPROJECT_TITLE
        frmBatchDef.Hide    '[バッチの定義] フォームを非表示にします。
        MousePointer = DEFAULT
        Exit Sub
    End If

    gbNeedSave = True       '保存が必要であることを示します。

    iSelBatch = lstBatches.ItemData(lstBatches.ListIndex)   'gabtBatches() で選択されているバッチのインデックス
    SetBatchDef iSelBatch, BATCH_EDIT               '[バッチの定義] フォームのフィールドを設定します。
    sOrigName = gabtBatches(iSelBatch).Name         '元のバッチ名を保存します。

    Do
        MousePointer = DEFAULT

        '[バッチの定義] フォームを表示します。
        frmBatchDef.Show MODAL

        If gbtBatchBfr.Name = sOrigName Then        '編集中にバッチ名は変更されませんでした。
            iSearchVal = -1
        Else
            iSearchVal = iSearchBatchName(gbtBatchBfr.Name)
            If iSearchVal <> -1 Then                '同じ名前のバッチが既に存在する場合
                MsgBox MB_DUPLICATE_NAME, MB_ICONEXCLAMATION, MB_DUPLICATE_NAME_TITLE
            End If
        End If

    Loop Until iSearchVal = -1      '有効な名前が入力されるまでループ実行します。

    If gbtBatchBfr.Name <> "ｷｬﾝｾﾙ" Then            'バッファには編集されたバッチ情報が含まれます。
        gabtBatches(iSelBatch) = gbtBatchBfr        '編集されたバッチ情報を配列に格納します。

        '編集中にバッチ名が変更された場合、[印刷バッチ] ボックスから
        'いったん名前を削除して、再び追加します。
        lstBatches.RemoveItem lstBatches.ListIndex  '一覧からバッチ名を削除します。
        lstBatches.AddItem gbtBatchBfr.Name         'バッチ名を一覧に追加します。
        lstBatches.ItemData(lstBatches.NewIndex) = iSelBatch    'gabtBatches の位置を保存します。
        lstBatches.ListIndex = lstBatches.NewIndex  '一覧からバッチを選択します。
    End If


End Sub

Sub cmdNew_Click ()
'このプロシージャは、gnNumOfBatches をインクリメントし、
'[バッチの定義] フォームを呼び出します。

Dim iSearchVal As Integer   'バッチ名の検索で返される値

    MousePointer = HOURGLASS

    If bSetActiveProjObj() = False Then     '作業中のプロジェクトのオブジェクトを取得できない場合
        MsgBox MB_NO_ACTIVEPROJECT, MB_ICONEXCLAMATION, MB_NO_ACTIVEPROJECT_TITLE
        frmBatchDef.Hide    '[バッチの定義] フォームを非表示にします。
        MousePointer = DEFAULT
        Exit Sub
    End If

    If lstBatches.ListCount = MAX_BATCHES Then  'バッチはこれ以上追加できません。
        MsgBox MB_MAX_BATCHES, MB_ICONEXCLAMATION, MB_MAX_BATCHES_TITLE
        MousePointer = DEFAULT
        Exit Sub
    End If

    gbNeedSave = True       '保存が必要であることを示します。

    '[バッチの定義] フォームの値を新しいバッチに合わせて設定します。
    SetBatchDef 0, BATCH_NEW

    Do
        MousePointer = DEFAULT

        '[バッチの定義] フォームを表示します。
        frmBatchDef.Show MODAL

        iSearchVal = iSearchBatchName(gbtBatchBfr.Name)
        If iSearchVal <> -1 Then    '同じ名前のバッチが既に存在する場合
            MsgBox MB_DUPLICATE_NAME, MB_ICONEXCLAMATION, MB_DUPLICATE_NAME_TITLE
        End If

    Loop Until iSearchVal = -1

    If gbtBatchBfr.Name <> "ｷｬﾝｾﾙ" Then            'バッファには新しいバッチ情報が含まれます。
        gnNumOfBatches = gnNumOfBatches + 1         'バッチのカウントを 1 つインクリメントします。
        gabtBatches(gnNumOfBatches) = gbtBatchBfr   '新しいバッチを配列に格納します。
        lstBatches.AddItem gbtBatchBfr.Name         '一覧に名前を追加します。
        'gabtBatches の位置を保存します。
        lstBatches.ItemData(lstBatches.NewIndex) = gnNumOfBatches
        lstBatches.ListIndex = lstBatches.NewIndex  '一覧から新しいバッチを選択します。
    End If

    If gnNumOfBatches = 1 Then                      '最初のバッチを一覧に追加します。
        cmdEdit.Enabled = True                      '[編集] ボタンを有効にします。
        cmdDelete.Enabled = True                    '[削除] ボタンを有効にします。
        cmdCopy.Enabled = True                      '[コピー] ボタンを有効にします。
        cmdSave.Enabled = True                      '[保存] ボタンを有効にします。
        cmdPrint.Enabled = True                     '[印刷] ボタンを有効にします。
    End If

End Sub

Sub cmdOpen_Click ()
'このプロシージャは、ユーザーの指定したバッチ ファイルを開き、
'バッチ情報をメモリにロードします。

Dim nFilenum As Integer                     '開くためのファイル番号
Dim nSize As Integer                        '入力用の文字列のサイズ
Dim nPos As Integer                         'ファイルのポインタの位置
Dim nBat As Integer                         'バッチのループ カウンタ
Dim nItem As Integer                        '項目のループ カウンタ
Dim sItemName As String                         '入力用の文字列に使用する変数

    '保存が必要な場合は、保存のダイアログを呼び出します。
    If gbNeedSave Then
        If MsgBox(MB_QUERYSAVE, MB_YESNO + MB_ICONQUESTION, MB_QUERYSAVE_TITLE) = IDYES Then
            cmdSave_Click
            If mbCancelSave Then        'ユーザーが保存のダイアログをキャンセルした場合
                mbCancelSave = False    'フラグをリセットします。
                Exit Sub                'プログラムを閉じずにサブルーチンを終了します。
            End If
        End If
    End If

    On Error GoTo OpenError

    nFilenum = FreeFile                     '有効なファイル番号を取得します。

    dlgCommon.CancelError = True            '[キャンセル] がクリックされた場合、エラーを生成します。
    dlgCommon.DialogTitle = DLG_OPEN_TITLE
    dlgCommon.DefaultExt = DLG_EXTENSION    'バッチ ファイルの既定の拡張子
    dlgCommon.Filter = DLG_OPENFILTER
    dlgCommon.Flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST
    dlgCommon.Action = DLG_FILE_OPEN

    Open dlgCommon.Filename For Binary As nFilenum  '入力用のファイルを開きます。
    sItemName = FILE_HEADER                     '入力用の文字列のサイズを設定します。
    Get #nFilenum, 1, sItemName                 'ファイルのヘッダー情報を取得します。
    If sItemName <> FILE_HEADER Then            '正しい印刷バッチ ファイルではありません。
        MsgBox MB_INVALID_FILE, MB_ICONEXCLAMATION, MB_INVALID_FILE_TITLE
        Close #nFilenum
        Exit Sub
    End If

    Get #nFilenum, , gnNumOfBatches                     'ファイル内のバッチ数を取得します。
    nBat = 0
    Do While (Not EOF(nFilenum)) And (nBat < gnNumOfBatches)

        nBat = nBat + 1                                 'バッチの数をインクリメントします。

        Get #nFilenum, , nSize                          'バッチ名のサイズを取得します。
        gabtBatches(nBat).Name = String$(nSize, " ")    'フィールドのサイズを正確に計算します。
        Get #nFilenum, , gabtBatches(nBat).Name         'バッチ名を取得します。

        Get #nFilenum, , gabtBatches(nBat).NumItems     'バッチ内の項目数を取得します。
        For nItem = 1 To gabtBatches(nBat).NumItems          '一覧のすべての項目に対してループを実行します。

            Get #nFilenum, , nSize                      '項目名のサイズを取得します。
            sItemName = String$(nSize, " ")             '入力用の文字列のサイズを設定します。
            Get #nFilenum, , sItemName                  '項目名を取得します。
            gabtBatches(nBat).Items(nItem).ItemName = sItemName     '項目名を設定します。

            Get #nFilenum, , nSize                      'テーブル名のサイズを取得します。
            If nSize > 0 Then                           'テーブル名が存在する場合、
                sItemName = String$(nSize, " ")         '入力用の文字列のサイズを設定します。
                Get #nFilenum, , sItemName              'テーブル名を取得します。
                gabtBatches(nBat).Items(nItem).Table = sItemName    'テーブル名を設定します。
            Else
                gabtBatches(nBat).Items(nItem).Table = ""           'テーブル名をクリアします。
            End If

            Get #nFilenum, , nSize                      'フィルタ名のサイズを取得します。
            If nSize > 0 Then                           'フィルタ名が存在する場合、
                sItemName = String$(nSize, " ")             '入力用の文字列のサイズを設定します。
                Get #nFilenum, , sItemName                  'フィルタ名を取得します。
                gabtBatches(nBat).Items(nItem).Filter = sItemName    'フィルタ名を設定します。
            Else
                gabtBatches(nBat).Items(nItem).Filter = ""           'フィルタ名をクリアします。
            End If

        Next

    Loop

    gnNumOfBatches = nBat                           'バッチの総数を保存します。
    If gnNumOfBatches > 0 Then
        cmdEdit.Enabled = True                      '[編集] ボタンを有効にします。
        cmdCopy.Enabled = True                      '[コピー] ボタンを有効にします。
        cmdDelete.Enabled = True                    '[削除] ボタンを有効にします。
        cmdSave.Enabled = True                      '[保存] ボタンを有効にします。
        cmdPrint.Enabled = True                     '[印刷] ボタンを有効にします。
    Else
        cmdEdit.Enabled = False                     '[編集] ボタンを無効にします。
        cmdCopy.Enabled = False                     '[コピー] ボタンを無効にします。
        cmdDelete.Enabled = False                   '[削除] ボタンを無効にします。
        cmdSave.Enabled = False                     '[保存] ボタンを無効にします。
        cmdPrint.Enabled = False                    '[印刷] ボタンを無効にします。
    End If

    lstBatches.Clear                                '[バッチ名] ボックスの一覧をクリアします。
    For nBat = 1 To gnNumOfBatches                  'すべてのバッチ項目に対してループを実行します。
        lstBatches.AddItem gabtBatches(nBat).Name   'バッチ名を一覧に追加します。
        lstBatches.ItemData(lstBatches.NewIndex) = nBat 'gabtBatches 配列での位置を保存します。
    Next
    lstBatches.ListIndex = 0

    gbNeedSave = False       '保存が必要でないことを示します。

    Close #nFilenum                                 'ファイルを閉じます。

Exit Sub

OpenError:
    Select Case Err
        Case CDERR_CANCEL   'ユーザーが保存のダイアログをキャンセルした場合
            Exit Sub        'これ以降の処理を行わずにサブルーチンを終了します。
        Case Else
            Close #nFilenum  'ファイルを閉じます。
            Error Err
    End Select

End Sub

Sub cmdPrint_Click ()
'このプロシージャは、OLE オートメーションを使用して、
'作業中のプロジェクト、または開いているすべてのプロジェクトで
'指定されたバッチ項目を印刷します。ビュー、テーブル、フィルタ、
'またはレポートをプロジェクトに適用するときに発生したエラーは
'すべて無視して、残りのバッチ項目が続けて印刷されるようにします。

Dim nNumProjects As Integer                 '印刷するプロジェクトの数
Dim iPrtBatch As Integer                    '選択されている印刷バッチの gabtBatches() でのインデックス
Dim nProj As Integer                        '印刷するすべてのプロジェクトに対してループを実行するときに使用します。
Dim nItems As Integer                       'すべてのバッチ項目に対してループを実行するときに使用します。
Dim sItemName As String                     '項目の名前
Dim sTableName As String                    'テーブルの名前
Dim sFilterName As String                   'フィルタの名前


    If bSetActiveProjObj() = False Then     '作業中のプロジェクトのオブジェクトを取得できない場合
        MsgBox MB_NO_ACTIVEPROJECT, MB_ICONEXCLAMATION, MB_NO_ACTIVEPROJECT_TITLE
        Exit Sub
    End If

    On Error GoTo PrintError

    goProjApp.Alerts False                  'Microsoft Project のエラー メッセージを無効にします。

    frmMain.Hide                            '印刷中にフォームを非表示にします。

    iPrtBatch = lstBatches.ItemData(lstBatches.ListIndex)   '印刷するバッチ番号

    If optWhichProjects(0).Value = True Then    '作業中のプロジェクトだけを印刷します。
        nNumProjects = 1
    Else                                        'すべてのプロジェクトを印刷します。
        nNumProjects = goProjApp.Projects.Count '開いているプロジェクトの数
    End If

    For nProj = 1 To nNumProjects               'すべてのプロジェクトに対してループを実行します。
        If nNumProjects > 1 Then
            goProjApp.Projects(nProj).Activate  'プロジェクトをアクティブにします。
        Else
            goActiveProj.Activate               '作業中のプロジェクトをアクティブにします。
        End If

        For nItems = 1 To gabtBatches(iPrtBatch).NumItems   'すべての項目に対してループを実行します。
            sItemName = gabtBatches(iPrtBatch).Items(nItems).ItemName   'バッチ項目の名前
            sTableName = gabtBatches(iPrtBatch).Items(nItems).Table     'テーブルの名前
            sFilterName = gabtBatches(iPrtBatch).Items(nItems).Filter   'フィルタの名前

            If Left$(sItemName, Len(VIEWTXT)) = VIEWTXT Then            '項目がビューの場合
                goProjApp.ViewApply Right$(sItemName, Len(sItemName) - Len(VIEWTXT))           'ビューをプロジェクトに適用します。

                If sTableName <> "" Then                                '指定されたテーブルがある場合
                    goProjApp.TableApply Right$(sTableName, Len(sTableName) - Len(TABLETXT))   'テーブルをプロジェクトに適用します。
                End If

                If sFilterName <> "" Then                               '指定されたフィルタがある場合
                    goProjApp.FilterApply Right$(sFilterName, Len(sFilterName) - Len(FILTERTXT)) 'フィルタをプロジェクトに適用します。
                End If

                goProjApp.FilePrint 1                                   'ビューを印刷します。

            ElseIf Left$(sItemName, Len(REPORTTXT)) = REPORTTXT Then    '項目がレポートの場合
                goProjApp.ReportPrint Right$(sItemName, Len(sItemName) - Len(REPORTTXT))   'レポートを印刷します。
            End If

        Next
    Next

    goProjApp.Alerts True                   'Microsoft Project のエラー メッセージを有効にします。

    frmMain.Show                            'フォームを再び表示します。

Exit Sub

PrintError:
    Select Case Err

        Case 440        '"この状況では OLE ﾒｿｯﾄﾞは使用できません。"
            Resume Next 'このエラーは、テーブルやフィルタに対応して
                        'いないビューに、そのいずれかを適用しようとしたか、
                        'または印刷できないビューを印刷しようとした場合に
                        '生成されます。エラーの原因となるテーブル、フィルタ、
                        'またはビューを適用せずに継続します。
        Case Else
            Error Err

    End Select

End Sub

Sub cmdSave_Click ()
'このプロシージャは、バッチの現在の一覧を、ユーザーが指定した
'ファイルに保存します。

Dim nFilenum As Integer                     '保存用のファイル番号
Dim nSize As Integer                        '出力用の文字列のサイズ
Dim nBat As Integer                         'バッチのループ カウンタ
Dim nItem As Integer                        '項目のループ カウンタ
Dim sHeader As String                       'ファイルのヘッダー情報

    mbCancelSave = False                    'フラグを False に初期化します。

    On Error GoTo SaveError

    nFilenum = FreeFile                     '未使用ファイルの番号を取得します。

    dlgCommon.CancelError = True            '[キャンセル] がクリックされた場合、エラーを生成します。
    dlgCommon.DialogTitle = DLG_SAVE_TITLE
    dlgCommon.DefaultExt = DLG_EXTENSION    'バッチ ファイルの既定の拡張子
    dlgCommon.Filter = DLG_SAVEFILTER
    dlgCommon.Flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST + OFN_OVERWRITEPROMPT
    dlgCommon.Action = DLG_FILE_SAVE        '[ファイル名を付けて保存] のダイアログを表示します。

    Open dlgCommon.Filename For Binary As nFilenum

    sHeader = FILE_HEADER                           'ファイルのヘッダー情報
    Put #nFilenum, 1, sHeader                       'ヘッダー情報をファイルに書き込みます。
    Put #nFilenum, , gnNumOfBatches                 'ファイルに含まれるバッチの数を書き込みます。
    For nBat = 1 To gnNumOfBatches                  'すべてのバッチに対してループを実行します。

        nSize = Len(gabtBatches(nBat).Name)         'バッチ名のサイズを保存します。
        Put #nFilenum, , nSize                      'バッチ名のサイズを書き込みます。
        Put #nFilenum, , gabtBatches(nBat).Name     '最初のバッチの名前を書き込みます。
        Put #nFilenum, , gabtBatches(nBat).NumItems 'バッチ項目の番号を書き込みます。
        For nItem = 1 To gabtBatches(nBat).NumItems '項目内のすべての項目に対してループを実行します。

            '項目名のサイズを保存します。
            nSize = Len(gabtBatches(nBat).Items(nItem).ItemName)
            Put #nFilenum, , nSize                  '項目名のサイズを書き込みます。
            '項目名をファイルに書き込みます。
            Put #nFilenum, , gabtBatches(nBat).Items(nItem).ItemName

            'テーブル名のサイズを保存します。
            nSize = Len(gabtBatches(nBat).Items(nItem).Table)
            Put #nFilenum, , nSize                  'テーブル名のサイズを書き込みます。

            'テーブル名が存在する場合は、それをファイルに書き込みます。
            If nSize > 0 Then
                Put #nFilenum, , gabtBatches(nBat).Items(nItem).Table
            End If

            'フィルタ名のサイズを保存します。
            nSize = Len(gabtBatches(nBat).Items(nItem).Filter)
            Put #nFilenum, , nSize                  'テーブル名のサイズを書き込みます。

            'フィルタ名が存在する場合は、それをファイルに書き込みます。
            If nSize > 0 Then
                Put #nFilenum, , gabtBatches(nBat).Items(nItem).Filter
            End If

        Next

    Next

    gbNeedSave = False       '保存が必要でないことを示します。

    Close #nFilenum                                 'ファイルを閉じます。

Exit Sub

SaveError:
    Select Case Err
        Case CDERR_CANCEL       'ユーザーが保存のダイアログをキャンセルした場合
            mbCancelSave = True 'ユーザーがキャンセルしたことを示すフラグを設定します。
            Exit Sub            'これ以降の処理を行わずにサブルーチンを終了します。
        Case Else
            Close #nFilenum  'ファイルを閉じます。
            Error Err
    End Select

End Sub

Sub Form_Load ()
'このプロシージャは、アプリケーションを最初に起動したときに
'呼び出されます。このプロシージャは、メインのフォームを画面の
'中央に配置し、Microsoft Project のアプリケーション オブジェクトを取得し、
'[バッチの定義] フォームをメモリにロードします。

    MousePointer = HOURGLASS

    mbCancelSave = False        'フラグを False に初期化します。

    'バッチ印刷プログラムが既に実行されているかどうかを調べ、
    '実行されている場合は、別のインスタンスが起動されないようにします。
    If App.PrevInstance Then
        MsgBox MB_PREV_INSTANCE, MB_ICONEXCLAMATION, MB_PREV_INSTANCE_TITLE
        End
    End If

    gbNeedSave = False          '保存のフラグを False に設定します。

    gnNumOfBatches = 0          'バッチの数を 0 に初期化します。
    Set goActiveProj = Nothing  'オブジェクトを Nothing に初期化します。
    Set goProjApp = Nothing     'オブジェクトを Nothing に初期化します。

    frmMain.Top = (Screen.Height - frmMain.Height) / 2  'フォームを上下中央に配置します。
    frmMain.Left = (Screen.Width - frmMain.Width) / 2   'フォームを左右中央に配置します。

    If bSetProjAppObj() = False Then  'Microsoft Project のアプリケーション オブジェクトを取得できない場合
        MsgBox MB_NO_APP_OBJECT, MB_ICONSTOP, MB_NO_APP_OBJECT_TITLE
        MousePointer = DEFAULT
        End                         'プログラムを終了します。
    End If

    If bSetActiveProjObj() = False Then     '作業中のプロジェクトのオブジェクトを取得できない場合
        MsgBox MB_NO_ACTIVEPROJECT, MB_ICONEXCLAMATION, MB_NO_ACTIVEPROJECT_TITLE
    End If

    Load frmBatchDef                '[バッチの定義] フォームをメモリにロードします。

    MousePointer = DEFAULT

End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
'このプロシージャは、バッチ ファイルを保存するかどうかをユーザーに
'確認し、プログラムを閉じます。

Dim nReply As Integer       'メッセージ ボックスでクリックされたボタンの値

    If gbNeedSave Then
        nReply = MsgBox(MB_QUERYSAVE, MB_YESNOCANCEL + MB_ICONQUESTION, MB_QUERYSAVE_TITLE)
        Select Case nReply
            Case IDCANCEL                   'ユーザーが [キャンセル] をクリックした場合
                Cancel = True
                Exit Sub
            Case IDYES                      'ユーザーが [はい] (変更を保存) をクリックした場合
                cmdSave_Click               '保存のプロシージャを呼び出します。
                If mbCancelSave Then        'ユーザーが保存のプロシージャをキャンセルした場合
                    mbCancelSave = False    'フラグをリセットします。
                    Cancel = True
                    Exit Sub                'プログラムを閉じずにサブルーチンを終了します。
                Else
                    End                     'プログラムを閉じます。
                End If
            Case IDNO                       'ユーザーが [いいえ] (変更を保存せずに終了) をクリックした場合
                End                         'プログラムを閉じます。
        End Select
    Else
        End                                 'プログラムを閉じます。
    End If


End Sub