DOS/V Power Report 1997 January/VPR9701A.ISO/PROJ95/EXAMPLES/TIMETRAK/TASKINFO.FRM

Text File | 1996-08-21 | 20KB | 646 lines

VERSION 2.00
Begin Form frmTInfo
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "frmTInfo"
   ClientHeight    =   4305
   ClientLeft      =   975
   ClientTop       =   3330
   ClientWidth     =   8880
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "ＭＳ Ｐゴシック"
   FontSize        =   9
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4710
   Left            =   915
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4305
   ScaleWidth      =   8880
   Top             =   2985
   Width           =   9000
   Begin SSPanel pnlMain
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "ＭＳ Ｐゴシック"
      FontSize        =   9
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   4290
      Left            =   30
      TabIndex        =   7
      Top             =   30
      Width           =   8835
      Begin CommandButton cmdCancel
         BackColor       =   &H00C0C0C0&
         Cancel          =   -1  'True
         Caption         =   "ｷｬﾝｾﾙ"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   375
         Left            =   7320
         TabIndex        =   5
         Tag             =   "Cancel"
         Top             =   660
         Width           =   1095
      End
      Begin CommandButton cmdOK
         BackColor       =   &H00C0C0C0&
         Caption         =   "OK"
         Default         =   -1  'True
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   375
         Left            =   7320
         TabIndex        =   4
         Top             =   195
         Width           =   1095
      End
      Begin SSPanel pnlGrid
         BevelOuter      =   1  'Inset
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   2625
         Left            =   135
         TabIndex        =   11
         Top             =   1545
         Width           =   8610
         Begin SSCommand cmdEdit
            FontBold        =   -1  'True
            FontItalic      =   0   'False
            FontName        =   "ＭＳ Ｐゴシック"
            FontSize        =   9
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   280
            Index           =   0
            Left            =   30
            Picture         =   TASKINFO.FRX:0000
            RoundedCorners  =   0   'False
            TabIndex        =   12
            TabStop         =   0   'False
            Tag             =   "Cross"
            Top             =   30
            Visible         =   0   'False
            Width           =   280
         End
         Begin SSCommand cmdEdit
            FontBold        =   -1  'True
            FontItalic      =   0   'False
            FontName        =   "ＭＳ Ｐゴシック"
            FontSize        =   9
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   280
            Index           =   1
            Left            =   315
            Picture         =   TASKINFO.FRX:05A2
            RoundedCorners  =   0   'False
            TabIndex        =   13
            TabStop         =   0   'False
            Tag             =   "Check"
            Top             =   30
            Visible         =   0   'False
            Width           =   280
         End
         Begin TextBox txtEdit
            Enabled         =   0   'False
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "ＭＳ Ｐゴシック"
            FontSize        =   9
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   315
            Left            =   615
            TabIndex        =   14
            TabStop         =   0   'False
            Tag             =   "Edit"
            Top             =   30
            Width           =   7950
         End
         Begin Grid Grid
            BorderStyle     =   0  'None
            Cols            =   9
            FixedCols       =   5
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "ＭＳ Ｐゴシック"
            FontSize        =   9
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            ForeColor       =   &H00000000&
            Height          =   2280
            HighLight       =   0   'False
            Left            =   15
            TabIndex        =   3
            Tag             =   "Homer"
            Top             =   330
            Width           =   8520
         End
         Begin Shape shpRect
            Height          =   285
            Left            =   15
            Top             =   30
            Width           =   600
         End
      End
      Begin SSPanel pnlName
         Alignment       =   2  'Left Justify - BOTTOM
         BevelOuter      =   1  'Inset
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   330
         Left            =   2160
         TabIndex        =   10
         Top             =   195
         Width           =   3795
      End
      Begin SSPanel pnlDateRange
         Alignment       =   1  'Left Justify - MIDDLE
         BevelOuter      =   1  'Inset
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   330
         Left            =   2160
         TabIndex        =   9
         Top             =   600
         Width           =   3795
      End
      Begin SSPanel pnlAsOf
         Alignment       =   1  'Left Justify - MIDDLE
         AutoSize        =   3  'AutoSize Child To Panel
         BevelOuter      =   1  'Inset
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   360
         Left            =   2160
         TabIndex        =   8
         Top             =   1005
         Width           =   2925
         Begin TextBox txtAsOf
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "ＭＳ Ｐゴシック"
            FontSize        =   9
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   330
            Left            =   15
            TabIndex        =   2
            Tag             =   "AsOf"
            Top             =   15
            Width           =   2895
         End
      End
      Begin Label lblName
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "ﾘｿｰｽ名:"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   240
         Left            =   1200
         TabIndex        =   0
         Top             =   240
         Width           =   855
      End
      Begin Label lblDateRange
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "日付の範囲:"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   240
         Left            =   960
         TabIndex        =   6
         Top             =   600
         Width           =   1095
      End
      Begin Label lblAsOf
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "更新の基準(&U):"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "ＭＳ Ｐゴシック"
         FontSize        =   9
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   240
         Left            =   765
         TabIndex        =   1
         Top             =   1050
         Width           =   1320
      End
   End
End
Option Explicit

'フォームの定数
Const CHECK = 1
Const CROSS = 0
Const M_EDIT = True
Const M_DEFAULT = False

'編集用のバッファを元に戻します。
Dim mUndoBuf As utUndo   'gridfunc.bas で宣言した型

'標準ボタンのプロパティのフラグ
Dim mbDefButt As Integer

'グリッドの編集モードのフラグ (編集モードの場合は True、標準モードの場合は False)
Dim mbEditMode As Integer

'AsOf ボックスの入力値が無効な場合
Dim mbInvalidAsOf As Integer

Sub CellEdit (nAction As Integer)

Dim nNewRow As Integer
Dim nNewCol As Integer

   On Error GoTo CellEditError

   Select Case nAction
      Case 0   '編集内容をキャンセルした場合 (取消ボタン)
         Grid.Row = mUndoBuf.nRow
         Grid.Col = mUndoBuf.nCol
         txtEdit.Text = mUndoBuf.sUndo
         ToggleEditMode M_DEFAULT   '編集モードをオフにします。
         Grid.SetFocus
      Case 1   '編集内容を確定した場合 (入力ボタン)
         nNewCol = Grid.Col                     '列を保存します。
         nNewRow = Grid.Row                     '行を保存します。
         If TypeOf ActiveControl Is Grid Then      'ユーザーが別のセルを選択した場合
            Grid.Col = mUndoBuf.nCol               '編集していたセルに戻ります。
            Grid.Row = mUndoBuf.nRow               '       "       "
         End If

         Select Case Grid.Col
            Case ADDWORK, ETC
               If Asc(Right$(Grid.Text, 1)) < 65 Then    '作業時間の単位がない場合、
                  Grid.Text = Grid.Text & gsDefWorkUnit  '   単位の既定値を追加します。
               End If
            Case START
               If InStr(Grid.Text, gsTimeSep) <> 0 Then   'ユーザーが時刻を含めて日付を指定した場合
                  txtEdit.Text = DateValue(txtEdit.Text) + TimeValue(txtEdit.Text)
               Else
                  txtEdit.Text = DateValue(txtEdit.Text) + gdtDefStartTime
               End If
            Case FINISH
               If InStr(Grid.Text, gsTimeSep) <> 0 Then   'ユーザーが時刻を含めて日付を指定した場合
                  Grid.Text = DateValue(Grid.Text) + TimeValue(Grid.Text)
               Else
                  Grid.Text = DateValue(Grid.Text) + gdtDefFinishTime
               End If
         End Select


         If Not CheckEdit() Then                   '編集内容が正しくない場合、
            txtEdit.SelStart = 0
            txtEdit.SelLength = 32000  '不正な箇所を反転表示します。
            txtEdit.SetFocus
         Else
            MarkCellDirty Grid.Col, Grid.Row, True
            ToggleEditMode M_DEFAULT
            If TypeOf ActiveControl Is Grid Then
               Grid.Col = nNewCol                  '新しいセルに戻ります。
               Grid.Row = nNewRow                  '       "         "
               Grid.SetFocus
            End If
         End If

   End Select

Exit Sub

CellEditError:
   Select Case Err
      Case 5           '不正な関数呼び出し
         Beep
         MsgBox MB_BAD_DATE_FORMAT, MB_ICONEXCLAMATION, MB_TIMESHEET
         txtEdit.SelStart = 0
         txtEdit.SelLength = 32000
         txtEdit.SetFocus
      Case Else
         Beep
         CellEdit CROSS
   End Select
   Exit Sub

End Sub

Sub cmdCancel_Click ()

   Dim rtn%, hWnd%


   'タスク情報のフォームを非表示にします。
   Me.Hide

   '[オプション] フォームを表示し、ほかのウィンドウの一番手前に移動します。
   frmOptions.Show
   frmOptions.cmdCancel.SetFocus
   hWnd% = frmOptions.hWnd
   If Not BringToTop(hWnd%) Then TerminateApplication

End Sub

Sub cmdCancel_GotFocus ()
   frmTInfo.Tag = "form"
End Sub

Sub cmdEdit_Click (Index As Integer)
'入力ボタンまたは取消ボタンのいずれかがクリックされた場合

   Select Case Index
      Case CHECK                    '編集を確定します。
         CellEdit CHECK
      Case CROSS                    '編集をキャンセルします。
         CellEdit CROSS
   End Select

End Sub

Sub cmdOK_Click ()

   Dim sAsOf As String
   Dim dtAsOf As Variant, dtAsOfTime As Variant

   On Error GoTo cmdOKError

   If ActiveControl.Tag = "AsOf" Then
      txtAsOf_LostFocus
   End If

   If Not mbInvalidAsOf Then
      gdtAsOfDate = txtAsOf.Text
      dtAsOf = gdtAsOfDate
      DoResUpdate (dtAsOf)
      DisplayTInfoForm
   End If

Exit Sub

cmdOKError:
   Beep
   If gbDbg Then MsgBox "cmdOK_Click: Error:" & Err & ", " & Error$, MB_ICONEXCLAMATION, MB_TIMESHEET
   Exit Sub

End Sub

Sub cmdOK_GotFocus ()
   frmTInfo.Tag = "form"
End Sub

Sub Form_GotFocus ()
   frmTInfo.Tag = "form"
End Sub

'このプロシージャは、フォームのコントロールのサイズや位置を設定したり、
'フォームを画面に配置するような、いわば見かけの部分を担当します。
Sub Form_Load ()

   'メインの 3D パネルのサイズと位置を設定します。
   pnlMain.Top = 0
   pnlMain.Left = 0
   pnlMain.Width = frmTInfo.ScaleWidth
   pnlMain.Height = frmTInfo.ScaleHeight

   '3D パネルのコントロールのサイズと位置を設定し、
   'タスク割り当てのグリッドを囲みます。
   shpRect.Top = 30
   shpRect.Left = 30
   cmdEdit(0).Top = 30    '取消
   cmdEdit(0).Left = 30
   cmdEdit(1).Top = 30    '入力
   cmdEdit(1).Left = 310
   txtEdit.Top = 30
   txtEdit.Left = 590
   txtEdit.Width = pnlGrid.Width - 620
   Grid.Top = 310
   Grid.Left = 25
   Grid.Width = pnlGrid.Width - 60
   Grid.Height = pnlGrid.Height - 340

   'フォームを画面の中央に配置します。
   frmTInfo.Top = (Screen.Height - frmTInfo.Height) / 2
   frmTInfo.Left = (Screen.Width - frmTInfo.Width) / 2

   'グリッド コントロールを初期化します。
   InitializeGrid

   txtAsOf.Text = gdtTodaysDate

End Sub

Sub Grid_GotFocus ()


   'グリッドがフォーカスを持つ最後のコントロールだったことを示します。
   frmTInfo.Tag = "grid"

   Grid_SelChange

End Sub

Sub Grid_KeyPress (KeyAscii As Integer)


      If CellIsEditable(-1, -1) Then
         ToggleEditMode M_EDIT         '編集モードをオンにします。
         If KeyAscii > 31 Then
            Grid.Text = Chr(KeyAscii)     'グリッドに文字列を入力します。
            txtEdit.Text = Grid.Text      '同じ文字列をエディット ボックスに表示します。
         End If
         txtEdit.SetFocus              'フォーカスをエディット ボックスに設定します。
         txtEdit.SelStart = 2          'カーソルを文字列の末尾に移動します。
      End If


End Sub

Sub Grid_SelChange ()

   If Not frmTInfo.Visible Then Exit Sub  'フォームが非表示になっている間に特定のプロパティが変更された場合、グリッドが gpf になる場合があります。

   Grid.Row = Grid.SelStartRow
   Grid.Col = Grid.SelStartCol

   'グリッドの文字列を編集バーに表示します。
   txtEdit.Text = Grid.Text


   If CellIsEditable(-1, -1) Then
      txtEdit.Enabled = True
   Else
      txtEdit.Enabled = False
   End If

End Sub

'編集モードと標準モードの切り替えに関連する動作の処理を行います。
'bMode = M_EDIT: 編集モードがオン。bMode = M_DEFAULT: 標準モードがオン
Sub ToggleEditMode (bMode As Integer)

   If bMode Then  '編集モード

      '標準の OK/キャンセルの動作を無効にします。
      cmdOK.Default = False
      cmdCancel.Cancel = False

      '入力ボタンと取消ボタンを表示します。
      cmdEdit(CHECK).Visible = True
      cmdEdit(CROSS).Visible = True

      '元に戻すためのバッファをロードします。
         mUndoBuf.sUndo = ActiveControl.Text
         mUndoBuf.nRow = Grid.Row
         mUndoBuf.nCol = Grid.Col

      '編集モードのフラグを設定します。
      mbEditMode = M_EDIT

   Else  '標準モード

      '標準の OK/キャンセルの動作を有効にします。
      cmdOK.Default = True
      cmdCancel.Cancel = True

      '入力ボタンと取消ボタンを非表示にします。
      cmdEdit(CHECK).Visible = False
      cmdEdit(CROSS).Visible = False

      '元に戻すためのバッファをクリアします。
      mUndoBuf.nTag = 0  '元に戻すためのバッファを無効にします。

      '編集モードのフラグをクリアします。
      mbEditMode = M_DEFAULT

   End If

End Sub

Sub txtAsOf_GotFocus ()
   frmTInfo.Tag = "form"
End Sub

Sub txtAsOf_LostFocus ()

Dim X

   On Error GoTo AsOfError

   If ActiveControl.Tag <> "Cancel" Then
      X = DateValue(txtAsOf.Text) + TimeValue(txtAsOf.Text) '無効な日付が入力された場合にエラーを返します。
      mbInvalidAsOf = False
   End If
   Exit Sub

AsOfError:
   If Err = 5 Then
      Beep
      mbInvalidAsOf = True
      MsgBox MB_BAD_ASOF_DATE, MB_ICONEXCLAMATION, MB_TIMESHEET
      txtAsOf.SelStart = 0
      txtAsOf.SelLength = 32000
      txtAsOf.SetFocus
   End If
   Exit Sub

End Sub

Sub txtEdit_Change ()

   If mbEditMode Then            '編集モードがオンの場合、
      Grid.Text = txtEdit.Text   '   グリッド セルに同じ文字列を表示します。
   End If

End Sub

Sub txtEdit_GotFocus ()

   Grid.SelStartRow = Grid.Row
   Grid.SelEndRow = Grid.Row
   Grid.SelStartCol = Grid.Col
   Grid.SelEndCol = Grid.Col
   Grid.HighLight = True
   If Not mbEditMode Then        '編集モードがオフの場合、
      txtEdit.Text = Grid.Text   '   グリッドの文字列を編集ボックスに表示し、
      ToggleEditMode M_EDIT      '   編集モードをオンにします。
   End If

End Sub

Sub txtEdit_KeyPress (KeyAscii As Integer)


   Select Case KeyAscii
      Case 13  'Enter
         KeyAscii = 0
         Grid.SetFocus
         'cmdEdit_Click (CHECK)
      Case 27  'Esc
         KeyAscii = 0
         cmdEdit_Click (CROSS)
      Case Else

   End Select

End Sub

Sub txtEdit_LostFocus ()

Dim sTemp As String


   Grid.HighLight = False
   sTemp = ActiveControl.Tag
   If sTemp <> "Cross" And sTemp <> "Cancel" Then
      cmdEdit_Click CHECK
   End If

End Sub