frmpipelinefixinput.frm

自来水公司的一个管理系统

                   
        Case 1  '放弃
            Call Cancel
        
        Case Else
            MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
    End Select

End Sub

Private Sub cmdCommandArray3_Click(Index As Integer)
    Select Case Index
        Case 0  '<<
            If adoPipelineFixRS.BOF Then         '记录集为空的情况
                'Warning "已经处于首记录！"
                Beep
                Exit Sub
            End If
            
            adoPipelineFixRS.MovePrevious        '如果已经是首条的情况,Beep
            If adoPipelineFixRS.BOF Then
                adoPipelineFixRS.MoveNext
                Beep
                Exit Sub
            End If
            
            adoPipelineFixRS.MoveFirst           '正常情况
            Call DisplayCurrentData
        
        Case 1  '<
            If adoPipelineFixRS.BOF Then
                'Warning "已经处于首记录！"
                Beep
                Exit Sub
            End If
            adoPipelineFixRS.MovePrevious
            If adoPipelineFixRS.BOF Then
                adoPipelineFixRS.MoveNext
                Beep
            Else
                Call DisplayCurrentData
            End If
        
        Case 2  '>
            If adoPipelineFixRS.EOF Then
                'Warning "已经处于尾记录！"
                Beep
                Exit Sub
            End If
            adoPipelineFixRS.MoveNext
            If adoPipelineFixRS.EOF Then
                adoPipelineFixRS.MovePrevious
                Beep
            Else
                Call DisplayCurrentData
            End If
        
        Case 3  '>>
            If adoPipelineFixRS.EOF Then         '记录集为空的情况
                'Warning "已经处于尾记录！"
                Beep
                Exit Sub
            End If
            
            adoPipelineFixRS.MoveNext            '如果已经是尾条的情况,Beep
            If adoPipelineFixRS.EOF Then
                adoPipelineFixRS.MovePrevious
                Beep
                Exit Sub
            End If
            
            adoPipelineFixRS.MoveLast            '正常情况
            Call DisplayCurrentData
        
        Case Else
            MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
    End Select
End Sub


'------------------------------------------------------
'窗体事件
'------------------------------------------------------
Private Sub Form_Load()
    MoveToCenter gMainFormRefer, Me
    
    '初始化记录集
    On Error GoTo errHandleOpen
    Set adoPipelineFixRS = New ADODB.Recordset
    Set adoPipelineFixRS.ActiveConnection = gConnect
    adoPipelineFixRS.CursorLocation = adUseClient
    adoPipelineFixRS.CursorType = adOpenKeyset
    adoPipelineFixRS.LockType = adLockOptimistic
    adoPipelineFixRS.Open "select * from PipelineFix"
    On Error GoTo 0
    
    Call DisplayCurrentData
    Call DisableInterface
    Call InitCommandBox
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Call Warning("记录集打开失败！" & Chr(13) & Err.Description)
    On Error GoTo 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoPipelineFixRS.Close
    Set adoPipelineFixRS = Nothing
    On Error GoTo 0
End Sub


'------------------------------------------------------
'自定义函数/过程
'------------------------------------------------------
Private Sub InitInterface()
    Me.txtPlID.Text = ""
    Me.dtpReportDate.value = Date
    Me.txtReportMan.Text = ""
    Me.txtReportPlace.Text = ""
    
    Me.dtpFixDate.value = Date
    Me.txtFixMan.Text = ""
    Me.rtbFixStatus.Text = ""
    
    Me.rtbNote.Text = ""
End Sub

Private Sub InitCommandBox()
    Call EnableCMD1
    '根据"编号"是否为空来决定是否打开"编辑"和"删除"按扭
    If Me.txtPlID.Text = "" Then
        cmdCommandArray1(1).Enabled = False '编辑
        cmdCommandArray1(2).Enabled = False '删除
    End If
    Call DisableCMD2
    Call EnableCMD3
End Sub

Private Sub EnableInterface()
    Me.dtpReportDate.Enabled = True
    Me.txtReportMan.Enabled = True
    Me.txtReportPlace.Enabled = True
    
    Me.dtpFixDate.Enabled = True
    Me.txtFixMan.Enabled = True
    Me.rtbFixStatus.Enabled = True
    
    Me.rtbNote.Enabled = True
End Sub

Private Sub DisableInterface()
    Me.dtpReportDate.Enabled = False
    Me.txtReportMan.Enabled = False
    Me.txtReportPlace.Enabled = False
    
    Me.dtpFixDate.Enabled = False
    Me.txtFixMan.Enabled = False
    Me.rtbFixStatus.Enabled = False
    
    Me.rtbNote.Enabled = False
End Sub

Private Sub Cancel()
    Call DisplayCurrentData
    Call DisableInterface
    Call InitCommandBox
End Sub

Private Sub Save()
    Dim strPlID As String
    
    If bytCommandFlag = 0 Then  '新增---保存
        '得到可用的编号
        strPlID = GetMaxPlID()
        If strPlID = "" Then
            Warning "得到可用的编号出错！！！"
            Exit Sub
        End If
        On Error GoTo errHandleAdd
        adoPipelineFixRS.AddNew
        adoPipelineFixRS!PlID = strPlID
    Else                        '编辑---保存
        On Error GoTo errHandleAdd
    End If
    With adoPipelineFixRS
    !ReportDate = Me.dtpReportDate.value
    !ReportMan = Trim(Me.txtReportMan.Text)
    !ReportPlace = Trim(Me.txtReportPlace.Text)
    
    !FixDate = Me.dtpFixDate.value
    !FixMan = Trim(Me.txtFixMan.Text)
    !FixStatus = Trim(Me.rtbFixStatus.Text)
    
    !Note = Trim(Me.rtbNote.Text)
    .Update
    End With
    On Error GoTo 0
    
    If bytCommandFlag = 0 Then  '新增---保存
        On Error Resume Next
        adoPipelineFixRS.MoveLast
        On Error GoTo 0
        Me.txtPlID.Text = strPlID
    End If
    Call DisableInterface
    Call InitCommandBox
    
    Exit Sub
    
    '-------错误处理---------
errHandleAdd:
    Call Warning("记录保存失败！" & Chr(13) & Err.Description)
    On Error GoTo 0
End Sub

Private Sub DeleteData()
    If adoPipelineFixRS.BOF Or adoPipelineFixRS.EOF Then Exit Sub
    
    On Error GoTo errHandleDel
    adoPipelineFixRS.Delete
    On Error GoTo 0
    On Error Resume Next
    adoPipelineFixRS.MoveNext
    If adoPipelineFixRS.EOF Then adoPipelineFixRS.MovePrevious
    On Error GoTo 0
    Call DisplayCurrentData
    Call InitCommandBox
    Exit Sub
    
    '-------错误处理---------
errHandleDel:
    Call Warning("记录删除失败！" & Chr(13) & Err.Description)
    On Error GoTo 0
End Sub

Private Function GetMaxPlID() As String
'得到表中当前尚未使用的编号
    Dim strMaxID As String
    Dim strSQL As String
    
    If adoPipelineFixRS.RecordCount < 1 Then
        strMaxID = ""
    Else
        strSQL = "select max(PlID) from PipelineFix"
        On Error GoTo errHandleExe
        strMaxID = gConnect.Execute(strSQL).Fields(0).value
        On Error GoTo 0
    End If
    If strMaxID = "" Then
        strMaxID = String(gPlIDLen - 1, "0") & "1"
    Else
        strMaxID = Trim(Str(Val(strMaxID) + 1))
        strMaxID = String(gPlIDLen - Len(strMaxID), "0") & strMaxID
    End If
    
    GetMaxPlID = strMaxID
    Exit Function
    
    '-------错误处理---------
errHandleExe:
    GetMaxPlID = ""     '执行SQL 语句出错
    On Error GoTo 0
End Function

Private Sub DisplayCurrentData()
    '将表中的当前数据记录显示在屏幕上
    If adoPipelineFixRS.EOF Or adoPipelineFixRS.BOF Then
        Call InitInterface
        Exit Sub
    End If
    
    With adoPipelineFixRS
    Me.txtPlID.Text = !PlID
    Me.dtpReportDate.value = !ReportDate
    Me.txtReportMan.Text = Trim(!ReportMan)
    Me.txtReportPlace.Text = Trim(!ReportPlace)
    
    Me.dtpFixDate.value = IIf(IsNull(!FixDate), Date, !FixDate)
    Me.txtFixMan.Text = Trim(!FixMan)
    Me.rtbFixStatus.Text = Trim(!FixStatus)
    
    Me.rtbNote.Text = Trim(!Note)
    End With
End Sub


Private Sub EnableCMD1()
   Dim i As Integer
   For i = 0 To cmdCommandArray1.Count - 1
        cmdCommandArray1(i).Enabled = True
   Next i
End Sub
Private Sub DisableCMD1()
   Dim i As Integer
   For i = 0 To cmdCommandArray1.Count - 1
        cmdCommandArray1(i).Enabled = False
   Next i
End Sub

Private Sub EnableCMD2()
   Dim i As Integer
   For i = 0 To cmdCommandArray2.Count - 1
        cmdCommandArray2(i).Enabled = True
   Next i
End Sub
Private Sub DisableCMD2()
   Dim i As Integer
   For i = 0 To cmdCommandArray2.Count - 1
        cmdCommandArray2(i).Enabled = False
   Next i
End Sub

Private Sub EnableCMD3()
   Dim i As Integer
   For i = 0 To cmdCommandArray3.Count - 1
        cmdCommandArray3(i).Enabled = True
   Next i
End Sub
Private Sub DisableCMD3()
   Dim i As Integer
   For i = 0 To cmdCommandArray3.Count - 1
        cmdCommandArray3(i).Enabled = False
   Next i
End Sub



'------------------------------------------------------
'控件常规事件
'------------------------------------------------------
Private Sub txtReportMan_GotFocus()
    Call AutoSelectText(txtReportMan)
End Sub

Private Sub txtReportMan_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtReportPlace_GotFocus()
    Call AutoSelectText(txtReportPlace)
End Sub

Private Sub txtReportPlace_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub

Private Sub txtFixMan_GotFocus()
    Call AutoSelectText(txtFixMan)
End Sub

Private Sub txtFixMan_KeyPress(KeyAscii As Integer)
    Call IfEnterKeyMoveNext(KeyAscii)
End Sub