设备检修_日常维护编辑.frm

新世纪ERP设备管理源代码

        End If
    End With
      
    '设置审核弃审按钮状态
    Call Sub_CheckStatus
       
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
     
    '屏蔽文本框,下拉组合框有效性判断
    Valilock = True
     
    '屏蔽网格失去焦点产生的有效性判断
    Changelock = True
       
    Select Case Button.Key
        Case "yl"                                            '预 览
            BillTextPrint Lab_Title, LrText, TextGroupCode, XtReportCode, False
        Case "dy"                                            '打 印
            Dim Yhanswer As Integer      '打印提示
            
            '用户确认是否打印单据
            Tsxx = "请确认是否打印当前单据?"
            Yhanswer = Xtxxts(Tsxx, 2, 2)
            If Yhanswer = 2 Then
                Exit Sub
            End If
            BillTextPrint Lab_Title, LrText, TextGroupCode, XtReportCode, True
        Case "xz"                                            '新 增
            Call Sub_AddBill
        Case "xg"                                            '修 改
            Call Sub_EditBill
        Case "sc"                                            '删 除
            Call Sub_DeleteBill
        Case "bc"                                            '保 存
            Call Sub_SaveBill
        Case "fq"                                            '放 弃
            Call Sub_AbandonBill
        Case "shsh"                                          '审 核
            Call Sub_CheckBill
        Case "shqs"                                          '弃 审
            Call Sub_AbandonCheck
        Case "first"                                         '首 张
            Call Sub_First
        Case "prev"                                          '上 张
            Call Sub_Prev
        Case "next"                                          '下 张
            Call Sub_Next
        Case "last"                                          '末 张
            Call Sub_Last
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
    End Select
       
    '解 锁
    Valilock = False
    Changelock = False
    TextChangeLock = False
        
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作
   
    Select Case KeyCode
        Case vbKeyF5          '增加单据
            If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
                Call Sub_AddBill
            End If
        Case vbKeyF3          '修改单据
            If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
                Call Sub_EditBill
            End If
        Case vbKeyF6          '保存单据
            If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
                Call Sub_SaveBill
            End If
    End Select

End Sub

Private Sub Sub_OperStatus(Str_Status As String)                 '工具条依据不同状态所进行的变化
  
    With Tlb_Action
        Select Case Str_Status
            Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
                '工具条
                .Buttons("dy").Enabled = True       '打印
                .Buttons("yl").Enabled = True       '预览
                .Buttons("xz").Enabled = True       '新增
                .Buttons("xg").Enabled = True       '修改
                .Buttons("sc").Enabled = True       '删除
                .Buttons("bc").Enabled = False      '保存
                .Buttons("fq").Enabled = False      '放弃
                .Buttons("first").Enabled = True    '首张
                .Buttons("prev").Enabled = True     '上张
                .Buttons("next").Enabled = True     '下张
                .Buttons("last").Enabled = True     '末张
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
                
                '设置审核弃审按钮状态
                Call Sub_CheckStatus
                
                '设置文本框录入状态
                Call Sub_LrtextStatus(False)
            Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
                 '工具条
                 .Buttons("dy").Enabled = False      '打印
                 .Buttons("yl").Enabled = False      '预览
                 .Buttons("xz").Enabled = False      '新增
                 .Buttons("xg").Enabled = False      '修改
                 .Buttons("sc").Enabled = False      '删除
                 .Buttons("bc").Enabled = True       '保存
                 .Buttons("fq").Enabled = True       '放弃
                 .Buttons("shsh").Enabled = False    '审核
                 .Buttons("shqs").Enabled = False    '弃审
                 .Buttons("first").Enabled = False   '首张
                 .Buttons("prev").Enabled = False    '上张
                 .Buttons("next").Enabled = False    '下张
                 .Buttons("last").Enabled = False    '末张
                 .Buttons("bz").Enabled = True       '帮助
                 .Buttons("fh").Enabled = True       '退出
                 
                 '设置文本框录入状态
                 Call Sub_LrtextStatus(True)
            Case "30"   '修改(（录入）调入修改功能、（列表）调入修改功能)
                '工具条
                .Buttons("dy").Enabled = False      '打印
                .Buttons("yl").Enabled = False      '预览
                .Buttons("xz").Enabled = False      '新增
                .Buttons("xg").Enabled = False      '修改
                .Buttons("sc").Enabled = False      '删除
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("shsh").Enabled = False    '审核
                .Buttons("shqs").Enabled = False    '弃审
                .Buttons("first").Enabled = False   '首张
                .Buttons("prev").Enabled = False    '上张
                .Buttons("next").Enabled = False    '下张
                .Buttons("last").Enabled = False    '末张
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
                
                '设置文本框录入状态
                Call Sub_LrtextStatus(True)
        End Select
    End With
    
End Sub

Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态

    '录入文本框状态设置
    If TextEnabled Then
        For jsqte = Max_Text_Index To 0 Step -1
            '判断文本框是否可编辑
            If Textboolean(jsqte, 5) Then
                LrText(jsqte).Enabled = True
            Else
                LrText(jsqte).Enabled = False
            End If
        Next jsqte
    Else
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Enabled = False
        Next jsqte
    End If

End Sub

Private Sub Sub_CheckStatus()                                       '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
    
    '根据当前单据状态来确定审核弃审按钮状态
    If Trim(LrText(20).Text) = "" Then
        Tlb_Action.Buttons("shsh").Enabled = True      '审核
        Tlb_Action.Buttons("shqs").Enabled = False   '弃审
    Else
        Tlb_Action.Buttons("shqs").Enabled = True      '弃审
        Tlb_Action.Buttons("shsh").Enabled = False   '审核
    End If
    
End Sub

Private Sub Sub_AddBill()                                                '新增一张单据
    
    Dim RecTemp As New ADODB.Recordset            '临时使用动态集
    Dim jsqte As Long                             '临时计数器
     If Not Security_Log("Dev_DayRepairEdit", Xtczybm, 1, True) Then
        Exit Sub
     End If
    '设置操作状态为新增(Fixed)
    Lab_OperStatus.Caption = "2"
   
    '设置工具条状态(Fixed)
    Call Sub_OperStatus("20")
   
    '清空VouchID(Fixed)
    Lab_BillId.Caption = ""
   
    '录入文本框清除内容
    For jsqte = Max_Text_Index To 0 Step -1
        LrText(jsqte).Tag = ""
        LrText(jsqte).Text = ""
    Next jsqte
   
    '[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
    TextChangeLock = True
    
    LrText(18).Text = Xtczy
    LrText(19).Text = Format(Xtrq, "yyyy-mm-dd")
    LrText(0).Enabled = False
    LrText(2).Enabled = False
    LrText(3).Enabled = False
    LrText(4).Enabled = False
    LrText(18).Enabled = False
    LrText(19).Enabled = False
    LrText(20).Enabled = False
    
    TextChangeLock = False
    
    '读取最新的单据编码
    LrText(0).Text = CreatBillCode(BillCode, False)
   
    '<<]
   
    '让第一个录入项得到焦点(Fixed)
    On Error Resume Next
    LrText(1).SetFocus
   
End Sub

Private Sub Sub_EditBill()                                                '修改一张单据
    
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
     If Not Security_Log("Dev_DayRepairEdit", Xtczybm, 1, True) Then
        Exit Sub
     End If
    '非有效单据不予进行修改动作
    If Val(Lab_BillId.Caption) = 0 Then
        Exit Sub
    End If
   
    '判断当前单据是否允许修改
    If Not Fun_AllowEdit Then
        Exit Sub
    End If
   
    '设置操作状态为修改
    Lab_OperStatus.Caption = "3"
   
    '设置工具条状态
    Call Sub_OperStatus("30")
      
    '显示制单人
    LrText(0).Enabled = False
    LrText(2).Enabled = False
    LrText(3).Enabled = False
    LrText(4).Enabled = False
    LrText(18).Enabled = False
    LrText(19).Enabled = False
    LrText(20).Enabled = False
    LrText(18).Text = Xtczy
   
End Sub

Private Sub Sub_DeleteBill()                                               '删除当前单据
    
    Dim YAnswer As Integer               '确认是否删除当前单据
    Dim jsqte As Long                    '临时使用计数器
     If Not Security_Log("Dev_DayRepairEdit", Xtczybm, 1, True) Then
        Exit Sub
     End If
    '非有效单据不予进行删除动作
    If Val(Lab_BillId.Caption) = 0 Then
        Exit Sub
    End If
   
    Tsxx = "请确认是否删除当前单据?"
    YAnswer = Xtxxts(Tsxx, 2, 2)
   
    If YAnswer = 1 Then
        
        '判断当前单据是否允许删除
        If Not Fun_AllowEdit Then
            Exit Sub
        End If
        
        '进行事务处理
        On Error GoTo Swcwcl
        Cw_DataEnvi.DataConnect.BeginTrans
        
        '1.删除单据所有内容
        Cw_DataEnvi.DataConnect.Execute ("Delete Dev_DayRepairRecord Where DayRepairRecordID=" & Val(Lab_BillId.Caption))
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '标识单据发生改动
        Bln_BillChange = True
        
        '单据ID置0
        Lab_BillId.Caption = 0
    Else
        Exit Sub
    End If
     
    '删除单据后重置状态
        
    '1.显示下一张单据
    Call Sub_Next
        
    '2.如果无下一张单据则搜索上一张单据
    If Val(Lab_BillId.Caption) = 0 Then
        Call Sub_Prev
    End If
        
    '3.如无单据则置单据为空状态
    If Val(Lab_BillId.Caption) = 0 Then
        '清除录入文本框
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Tag = ""
            LrText(jsqte).Text = ""