home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 January / VPR9701A.ISO / PROJ95 / EXAMPLES / TIMETRAK / GRIDFUNC.BAS < prev    next >
BASIC Source File  |  1996-08-21  |  16KB  |  553 lines
  1. 'GRIDFUNC.BAS  -  このモジュールには、すべての主要なグリッドの
  2. '"プロパティ"、"メソッド"、および妥当性検査のための関数が含まれます。
  3. '
  4.  
  5. Option Explicit
  6. Option Compare Text
  7.  
  8. 'この配列は、グリッド内でどのセルが編集可能かを確認します。
  9. 'グリッド内の各セルには、CellEditTable と同じ値が入力されて
  10. 'います。グリッドに値を書き込むプロシージャでは、CellEditTable を
  11. 'チェックして、指定されたセルが変更可能なものかどうかを確認します。
  12. '入力値 "True" は編集が可能であることを示し、"False" は編集できない
  13. 'ことを示します。
  14. Dim mabCellEditTable() As Integer
  15.  
  16. 'この配列は、mabCellEditTable に類似していますが、
  17. 'mabCellEditTable とは異なり、指定されたセルの内容を
  18. 'ユーザーが変更したかどうかを示します。
  19. Dim mabCellChangedTable() As Integer
  20.  
  21. 'グリッドが空の場合、True を返します。
  22. Dim mbGridEmpty As Integer
  23.  
  24.  
  25. 'グリッドのタイトル行 (列見出し)
  26.  Const TITLE_ROW = 0
  27.  
  28. 'ColAlignment、FixedAlignment プロパティ
  29.  Const GRID_ALIGNLEFT = 0
  30.  Const GRID_ALIGNRIGHT = 1
  31.  Const GRID_ALIGNCENTER = 2
  32.  
  33. 'Fillstyle プロパティ
  34.  Const GRID_SINGLE = 0
  35.  Const GRID_REPEAT = 1
  36.  
  37. 'ユーザーが TInfo フォームを編集した後の
  38. 'グリッドの行のデータを含みます。
  39. 'been edited by the user.
  40. Type utRowRec
  41.    nAUID As Integer              '割り当ての固有 ID
  42.    nTID As Integer               'タスク ID
  43.    nActWork As Integer           'リソースの実績作業時間
  44.    nRemWork As Integer           'リソースの残存作業時間
  45.    nAddWork As Integer           '追加作業時間
  46.    bAddWorkDirty As Integer      'ユーザーが AddWord フィールドを編集したかどうかを示すフラグ
  47.    nETC As Integer               '残存作業時間の新しい見積り
  48.    bETCDirty As Integer          'ユーザーが ETC フィールドを編集したかどうかを示すフラグ
  49.    dtStart As Variant            'リソースがタスクの作業を開始する日付
  50.    bStartDirty As Integer        'ユーザーが [開始日] フィールドを編集したかどうかを示すフラグ
  51.    dtFinish As Variant           'リソースがタスクの作業を終了する日付
  52.    bFinishDirty As Integer       'ユーザーが [終了日] フィールドを編集したかどうかを示すフラグ
  53. End Type
  54.  
  55. 'この構造は、frmTaskInfo の編集を元に戻すためのバッファとして使用します。
  56. Type utUndo
  57.    sUndo As String         '元に戻す文字列
  58.    nRow As Integer         'nRow と nCol を使用して、sUndo の値の
  59.    nCol As Integer         'グリッドの座標を保存します。
  60.    nTag As Integer          '元に戻す文字列が含まれていたコントロールの種類。0 = 無効な内容、1 = グリッド、2 = テキスト ボックス
  61. End Type
  62.  
  63. 'iCol および iRow で指定したセルの CellEditTable への入力を行います。
  64. 'bEdit の値によって、指定したセルが編集可能かどうかが決まります。
  65. 'True = 編集可能、False = 編集不可
  66. '
  67. 'iCol = -1 かつ iRow = -1 の場合、AllowCellEditing では、
  68. 'グリッドで現在選択されているセルの座標が使用されます。
  69. '
  70. Sub AllowCellEditing (ByVal iCol As Integer, ByVal iRow As Integer, bEdit As Integer)
  71.  
  72.    
  73.    Dim F As frmTInfo
  74.    Set F = frmTInfo
  75.  
  76.    '引数をチェックします。
  77.    Select Case iCol
  78.       Case -1
  79.          iCol = F!Grid.SelStartCol
  80.       Case AUID To FINISH
  81.          'OK!
  82.       Case Else
  83.          '値が範囲外です。
  84.          Error 9
  85.    End Select
  86.    Select Case iRow
  87.       Case -1
  88.          iRow = F!Grid.SelStartRow
  89.       Case 1 To UBound(mabCellEditTable, 2)
  90.          'OK!
  91.       Case Else
  92.          '値が範囲外です。
  93.          Error 9
  94.    End Select
  95.  
  96.    mabCellEditTable(iCol, iRow) = bEdit
  97.  
  98. End Sub
  99.  
  100. Function CellIsDirty (ByVal iCol As Integer, ByVal iRow As Integer) As Integer
  101.  
  102.    Dim F As frmTInfo
  103.    Set F = frmTInfo
  104.  
  105.    '引数をチェックします。
  106.    Select Case iCol
  107.       Case -1
  108.          iCol = F!Grid.SelStartCol
  109.       Case ADDWORK To FINISH
  110.          'OK!
  111.       Case Else
  112.          '値が範囲外です。
  113.          Error 9
  114.    End Select
  115.    Select Case iRow
  116.       Case -1
  117.          iRow = F!Grid.SelStartRow
  118.       Case 1 To UBound(mabCellChangedTable, 2)
  119.          'OK!
  120.       Case Else
  121.          '値が範囲外です。
  122.          Error 9
  123.    End Select
  124.    CellIsDirty = mabCellChangedTable(iCol, iRow)
  125.  
  126. End Function
  127.  
  128. '指定されたセル座標に対する CellEditTable で、編集が可能かどうかを
  129. '返します。iCol = -1 かつ iRow = -1 の場合、グリッドで現在選択
  130. 'されているセルの座標が使用されます。
  131. '
  132. Function CellIsEditable (iCol, iRow) As Integer
  133.  
  134.    Dim F As frmTInfo
  135.    Set F = frmTInfo
  136.  
  137.    '引数をチェックします。
  138.    Select Case iCol
  139.       Case -1
  140.          iCol = F!Grid.SelStartCol
  141.       Case AUID To FINISH
  142.          'OK!
  143.       Case Else
  144.          '値が範囲外です。
  145.          Error 9
  146.    End Select
  147.    Select Case iRow
  148.       Case -1
  149.          iRow = F!Grid.SelStartRow
  150.       Case 1 To UBound(mabCellEditTable, 2)
  151.          'OK!
  152.       Case Else
  153.          '値が範囲外です。
  154.          Error 9
  155.    End Select
  156.  
  157.    CellIsEditable = mabCellEditTable(iCol, iRow)
  158.  
  159. End Function
  160.  
  161. 'グリッドの入力値を検査します。入力値が有効な場合は True を返し、
  162. '無効な場合は False を返します。
  163. '
  164. Function CheckEdit () As Integer
  165.  
  166.    Dim F As frmTInfo
  167.    Dim iRow As Integer
  168.    Dim iCol As Integer
  169.    Dim sGridText As String
  170.    Dim iTmpCol As Integer
  171.    Dim dtStart As Variant
  172.    Dim dtFinish As Variant
  173.    Dim tmp As Variant
  174.    Dim nAddWork As Integer
  175.    Dim nETC As Integer
  176.  
  177.    On Error GoTo CheckEditError
  178.    
  179.    Set F = frmTInfo
  180.    iRow = F!Grid.Row
  181.    iCol = F!Grid.Col
  182.    sGridText = F!Grid.Text
  183.  
  184.    Select Case iCol
  185.       Case ADDWORK
  186. 2010     nAddWork = goProjApp.DurationValue(sGridText)
  187.          Select Case nAddWork
  188.             Case Is < 0
  189.             '入力値が無効な場合
  190.                Beep
  191.                MsgBox MB_LESS_THAN_ZERO, MB_ICONEXCLAMATION, MB_TIMESHEET
  192.                CheckEdit = False
  193.             Case Is = 0
  194.                '残存作業時間を ETC にコピーします。
  195.                F!Grid.Col = REMWORK
  196.                tmp = F!Grid.Text
  197.                F!Grid.Col = ETC
  198.                F!Grid.Text = tmp
  199.                F!Grid.Col = iCol
  200.                CheckEdit = True
  201.             Case Is > 0
  202.                '残存作業時間から追加作業時間を引き、
  203.                'その計算結果を ETC に入力します。
  204.                F!Grid.Col = ETC
  205.                tmp = goProjApp.DurationValue(F!Grid.Text)
  206.                tmp = tmp - nAddWork
  207.             
  208.                If tmp > 0 Then
  209.                   F!Grid.Text = goProjApp.DurationFormat(tmp, gnDefWorkUnit)
  210.                Else
  211.                   F!Grid.Text = "0" + gsDefWorkUnit
  212.                   AllowCellEditing FINISH, -1, True
  213.                End If
  214.                F!Grid.Col = iCol
  215.                CheckEdit = True
  216.          End Select
  217.       Case ETC
  218. 2020    nETC = goProjApp.DurationValue(sGridText)
  219.         Select Case nETC
  220.             Case Is < 0
  221.             '入力値が無効な場合
  222.                Beep
  223.                MsgBox MB_LESS_THAN_ZERO, MB_OK + MB_ICONEXCLAMATION, MB_TIMESHEET
  224.                CheckEdit = False
  225.             Case Is = 0
  226.             'ETC = 0 の場合、終了日の編集を可能にします。
  227.                AllowCellEditing FINISH, -1, True
  228.                CheckEdit = True
  229.             Case Is > 0
  230.             '入力値が有効な場合
  231.                AllowCellEditing FINISH, -1, False
  232.                CheckEdit = True
  233.             Case Else
  234.             '入力値が無効な場合
  235.                Beep
  236.                MsgBox MB_UNRECOGNIZED_ENTRY, MB_OK + MB_ICONEXCLAMATION, MB_TIMESHEET
  237.                CheckEdit = False
  238.          End Select
  239.       Case Start
  240. 2030     Select Case DateValue(sGridText)
  241.             Case Is >= DateValue(goActiveProj.Start)
  242.                CheckEdit = True
  243.             Case Else
  244.                Beep
  245.                MsgBox MB_START_NOT_VALID, MB_OK + MB_ICONEXCLAMATION, MB_TIMESHEET
  246.                CheckEdit = False
  247.          End Select
  248.       Case FINISH
  249.          '終了日に開始日より後の日付が指定されているかどうかを確認します。
  250. 2040     dtFinish = DateValue(sGridText)
  251.          F!Grid.Col = Start
  252. 2050     dtStart = DateValue(F!Grid.Text)
  253.          If DateDiff("d", dtStart, dtFinish) < 0 Then
  254.             Beep
  255.             MsgBox MB_FINISH_NOT_VALID, MB_OK + MB_ICONEXCLAMATION, MB_TIMESHEET
  256.             CheckEdit = False
  257.          Else
  258.             CheckEdit = True
  259.          End If
  260.          F!Grid.Col = iCol
  261.    End Select
  262. Exit Function
  263.  
  264. CheckEditError:
  265.    Select Case Erl
  266.       Case 2010, 2020
  267.          '入力値が正しくない場合
  268.          Beep
  269.          MsgBox MB_UNRECOGNIZED_ENTRY, MB_OK + MB_ICONEXCLAMATION, MB_TIMESHEET
  270.          CheckEdit = False
  271.       Case 2030, 2040
  272.          '日付の形式が正しくない場合
  273.          Beep
  274.          MsgBox MB_BAD_DATE_FORMAT, MB_ICONEXCLAMATION, MB_TIMESHEET
  275.          CheckEdit = False
  276.       Case 2050
  277.          '日付の形式が正しくない場合
  278.          F!Grid.Col = iTmpCol
  279.          Beep
  280.          MsgBox MB_BAD_DATE_FORMAT, MB_ICONEXCLAMATION, MB_TIMESHEET
  281.          CheckEdit = False
  282.       Case Else
  283.          '予期しないエラー
  284.          CheckEdit = False
  285.    End Select
  286.    Exit Function
  287.  
  288. End Function
  289.  
  290. 'autInfo 配列に格納されている行のカウントを返します。
  291. 'autInfo 配列は、ReDim を使用して修正します。
  292. '
  293. Function GetGridInfo (autInfo() As utRowRec) As Integer
  294.    
  295.    Dim oApp As object               'Winproj アプリケーション オブジェクト
  296.    Dim F As frmTInfo                'frmTInfo フォームのオブジェクト
  297.    Dim nRows As Integer             'グリッド内の行数
  298.    Dim iRow As Integer              'グリッド内の行にインデックスを付けるためのループ カウンタ
  299.    Dim iCol As Integer              'グリッド内の列にインデックスを付けるためのループ カウンタ
  300.    Dim vntGVal As Variant           'グリッドの文字列または値
  301.    Dim tmp As Variant               '雑多な値を保存するための一時的な変数
  302.    
  303.    On Error GoTo GetGridInfoError
  304.  
  305.    Set oApp = goProjApp
  306.    Set F = frmTInfo
  307.    
  308.    'グリッドが空かどうかを確認し、空の場合は終了します。
  309.    If mbGridEmpty Then
  310.       GetGridInfo = 0
  311.       Exit Function
  312.    End If
  313.  
  314.    nRows = F!Grid.Rows
  315.    ReDim autInfo(1 To nRows - 1) As utRowRec
  316.    For iRow = 1 To nRows - 1
  317.       For iCol = AUID To FINISH
  318.          F!Grid.Row = iRow
  319.          F!Grid.Col = iCol
  320.          vntGVal = F!Grid.Text
  321.          Select Case iCol
  322.             Case AUID
  323.                autInfo(iRow).nAUID = vntGVal
  324.             Case TASKID
  325.                autInfo(iRow).nTID = vntGVal
  326.             Case TASKNAME
  327.                'タスク名は必要ではありません。
  328.             Case ACTWORK
  329.                tmp = oApp.DurationValue(vntGVal)
  330.                autInfo(iRow).nActWork = CInt(tmp)
  331.             Case REMWORK
  332.                tmp = oApp.DurationValue(vntGVal)
  333.                autInfo(iRow).nRemWork = CInt(tmp)
  334.             Case ADDWORK
  335.                tmp = oApp.DurationValue(vntGVal)
  336.                autInfo(iRow).nAddWork = CInt(tmp)
  337.                autInfo(iRow).bAddWorkDirty = CellIsDirty(iCol, iRow)
  338.             Case ETC
  339.                tmp = oApp.DurationValue(vntGVal)
  340.                autInfo(iRow).nETC = CInt(tmp)
  341.                autInfo(iRow).bETCDirty = CellIsDirty(iCol, iRow)
  342.             Case Start
  343.                autInfo(iRow).dtStart = vntGVal
  344.                autInfo(iRow).bStartDirty = CellIsDirty(iCol, iRow)
  345.             Case FINISH
  346.                autInfo(iRow).dtFinish = vntGVal
  347.                autInfo(iRow).bFinishDirty = CellIsDirty(iCol, iRow)
  348.          End Select
  349.       Next iCol
  350.    Next iRow
  351.    GetGridInfo = nRows
  352.    
  353. Exit Function
  354.  
  355. GetGridInfoError:
  356.    Beep
  357.    MsgBox MB_GENERIC_ERROR + " Err#" + Str$(Err), MB_ICONEXCLAMATION, MB_TIMESHEET
  358.    TerminateApplication
  359.  
  360. End Function
  361.  
  362. Sub GridAddRow (utRowInfo As utAssignment)
  363.  
  364.    Dim iCurRow As Integer
  365.    Dim oApp As object
  366.    Dim F As frmTInfo
  367.    Set F = frmTInfo
  368.    Set oApp = goProjApp
  369.  
  370.    If mbGridEmpty Then
  371.       F!Grid.Row = 1
  372.    Else
  373.       F!Grid.Rows = F!Grid.Rows + 1
  374.       F!Grid.Row = F!Grid.Rows - 1
  375.       ReDim Preserve mabCellEditTable(AUID To FINISH, TITLE_ROW To F!Grid.Row) As Integer
  376.       ReDim Preserve mabCellChangedTable(ADDWORK To FINISH, 0 To F!Grid.Row) As Integer
  377.    End If
  378.    
  379.    iCurRow = F!Grid.Row
  380.  
  381.    F!Grid.Col = AUID
  382.    F!Grid.Text = utRowInfo.nAUID
  383.    AllowCellEditing AUID, iCurRow, False
  384.  
  385.    F!Grid.Col = TASKID
  386.    F!Grid.Text = utRowInfo.nTID
  387.    AllowCellEditing TASKID, iCurRow, False
  388.    
  389.    F!Grid.Col = TASKNAME
  390.    F!Grid.Text = utRowInfo.sTName
  391.    AllowCellEditing TASKNAME, iCurRow, False
  392.  
  393.    F!Grid.Col = ACTWORK
  394.    F!Grid.Text = oApp.DurationFormat(utRowInfo.nActWork, gnDefWorkUnit)
  395.    AllowCellEditing ACTWORK, iCurRow, False
  396.  
  397.    F!Grid.Col = REMWORK
  398.    F!Grid.Text = oApp.DurationFormat(utRowInfo.nRemWork, gnDefWorkUnit)
  399.    AllowCellEditing REMWORK, iCurRow, False
  400.  
  401.    F!Grid.Col = ADDWORK
  402.    F!Grid.Text = "0"
  403.    AllowCellEditing ADDWORK, iCurRow, True
  404.    MarkCellDirty ADDWORK, iCurRow, False
  405.    
  406.    F!Grid.Col = ETC
  407.    F!Grid.Text = oApp.DurationFormat(utRowInfo.nRemWork, gnDefWorkUnit)
  408.    AllowCellEditing ETC, iCurRow, True
  409.    MarkCellDirty ETC, iCurRow, False
  410.  
  411.    F!Grid.Col = Start
  412.    F!Grid.Text = utRowInfo.dtStart
  413.    '実績作業時間が 0 の場合にのみ、
  414.    '実績開始日の入力を可能にします。
  415.    If utRowInfo.nActWork > 0 Then
  416.       AllowCellEditing Start, iCurRow, False
  417.    Else
  418.       AllowCellEditing Start, iCurRow, True
  419.    End If
  420.    MarkCellDirty Start, iCurRow, False
  421.  
  422.    F!Grid.Col = FINISH
  423.    F!Grid.Text = utRowInfo.dtFinish
  424.    '残存作業時間が 0 の場合にのみ、
  425.    '実績終了日の入力を可能にします。
  426.    If utRowInfo.nRemWork > 0 Then
  427.       AllowCellEditing FINISH, iCurRow, False
  428.    Else
  429.       AllowCellEditing FINISH, iCurRow, True
  430.    End If
  431.    MarkCellDirty FINISH, iCurRow, False
  432.  
  433.    mbGridEmpty = False
  434.    
  435. End Sub
  436.  
  437. 'グリッドの現在の内容をクリアし、行のプロパティを 2 に戻します。
  438. 'また、mabCellEditTable と mbGridEmtpy を変更します。
  439. '列見出しへの影響はありません。
  440. '
  441. Sub GridReset ()
  442.  
  443.    Dim iCol As Integer, iRow As Integer, i As Integer
  444.    Dim F As frmTInfo
  445.    Set F = frmTInfo
  446.  
  447.    F!Grid.Rows = 2
  448.    F!Grid.Row = 1
  449.    For i = AUID To FINISH
  450.       F!Grid.Col = i
  451.       F!Grid.Text = ""
  452.    Next i
  453.  
  454.    'CellEditTable を更新します。
  455.    ReDim mabCellEditTable(AUID To FINISH, TITLE_ROW To 1) As Integer
  456.    For iCol = AUID To FINISH
  457.       For iRow = TITLE_ROW To 1
  458.          mabCellEditTable(iCol, iRow) = False
  459.       Next iRow
  460.    Next iCol
  461.  
  462.    'CellChangedTable を更新します。
  463.    ReDim mabCellChangedTable(ADDWORK To FINISH, TITLE_ROW To 1) As Integer
  464.    For iCol = ADDWORK To FINISH
  465.       For iRow = TITLE_ROW To 1
  466.          mabCellChangedTable(iCol, iRow) = False
  467.       Next iRow
  468.    Next iCol
  469.  
  470.    '現在グリッドが空であることを示します。
  471.    mbGridEmpty = True
  472.  
  473. End Sub
  474.  
  475. 'Grid コントロールの列の見出しと幅を設定します。
  476. 'また、mabCellEditTable と mbGridEmtpy の初期値を
  477. '設定します。InitializeGrid は、TInfo フォームの
  478. 'ロード プロシージャから呼び出されます。
  479. '
  480. Sub InitializeGrid ()
  481.  
  482. Dim F As frmTInfo, iGCol As Integer, iCol As Integer, iRow As Integer
  483. Set F = frmTInfo
  484.  
  485. Const TITLE_ROW = 0
  486.  
  487.    F!Grid.Row = TITLE_ROW
  488.    F!Grid.Col = AUID
  489.    F!Grid.Text = "auid"
  490.    F!Grid.Col = TASKID
  491.    F!Grid.Text = GRID_TASKID
  492.    F!Grid.Col = TASKNAME
  493.    F!Grid.Text = GRID_TASKNAME
  494.    F!Grid.Col = ACTWORK
  495.    F!Grid.Text = GRID_ACTWORK
  496.    F!Grid.Col = REMWORK
  497.    F!Grid.Text = GRID_REMWORK
  498.    F!Grid.Col = ADDWORK
  499.    F!Grid.Text = GRID_ADDWORK
  500.    F!Grid.Col = ETC
  501.    F!Grid.Text = GRID_ETC
  502.    F!Grid.Col = Start
  503.    F!Grid.Text = GRID_START
  504.    F!Grid.Col = FINISH
  505.    F!Grid.Text = GRID_FINISH
  506.  
  507.    F!Grid.RowHeight(TITLE_ROW) = 500
  508.  
  509.    F!Grid.ColWidth(AUID) = 1  'この列はユーザーには見えません。
  510.    F!Grid.ColWidth(TASKID) = 500
  511.    F!Grid.ColWidth(TASKNAME) = 2200
  512.    For iGCol = ACTWORK To FINISH
  513.       F!Grid.ColWidth(iGCol) = 900
  514.    Next iGCol
  515.  
  516.    
  517.    'グリッドが空であることを示します。
  518.    mbGridEmpty = True
  519.  
  520.    F!Grid.Row = 1
  521.    F!Grid.Col = ADDWORK
  522. End Sub
  523.  
  524. Sub MarkCellDirty (ByVal iCol As Integer, ByVal iRow As Integer, bDirty As Integer)
  525.  
  526.    Dim F As frmTInfo
  527.    Set F = frmTInfo
  528.  
  529.    '引数をチェックします。
  530.    Select Case iCol
  531.       Case -1
  532.          iCol = F!Grid.SelStartCol
  533.       Case ADDWORK To FINISH
  534.          'OK!
  535.       Case Else
  536.          '値が範囲外です。
  537.          Error 9
  538.    End Select
  539.    Select Case iRow
  540.       Case -1
  541.          iRow = F!Grid.SelStartRow
  542.       Case 1 To UBound(mabCellChangedTable, 2)
  543.          'OK!
  544.       Case Else
  545.          '値が範囲外です。
  546.          Error 9
  547.    End Select
  548.    
  549.    mabCellChangedTable(iCol, iRow) = bDirty
  550.    
  551. End Sub
  552.  
  553.