b

VB开发的ERP系统

                LrText(5).Text = Trim(.Fields("Quantity") & "")                            '数量
                LrText(6).Text = Format(Trim(.Fields("PurReciptDate") & ""), "yyyy-mm-dd") '进料日期
                LrText(7).Text = Trim(.Fields("AreaName") & "")                            '产地名称
                LrText(8).Text = Format(Trim(.Fields("stoCheckDate") & ""), "yyyy-mm-dd")  '检验日期
                LrText(9).Text = Trim(.Fields("gradename") & "")                           '质量等级
                LrText(10).Text = Trim(.Fields("cgsy") & "")                               '采购质量和事由
                LrText(11).Text = Trim(.Fields("zgyj") & "")                               '总工程师意见
                LrText(12).Text = Trim(.Fields("zgzl") & "")                               '主管领导指令
                LrText(13).Text = Trim(.Fields("sccyj") & "")                              '生产技术处使用意见
                LrText(17).Text = Trim(.Fields("stockchecknum") & "")                      '单据号
                
                If IsXz = True Then
                    LrText(15).Text = Trim(.Fields("Maker") & "")                          '制单人
                    LrText(16).Text = Trim(.Fields("Checker") & "")                        '审核人
                End If
                
                Cbo_Result.Clear                                                   '
                Cbo_Result.AddItem "是"
                Cbo_Result.AddItem "否"
                If .Fields("ifuse") = 1 Then
                    Cbo_Result.ListIndex = 0
                Else
                    Cbo_Result.ListIndex = 1
                End If
                TextChangeLock = False    '文本框解锁
                '<<]
            End If
        End With
    Else
            '本张单据查询字符串
        Sqlstr = "SELECT * FROM QC_V_StockDemotion Where StockCheckMainID=" & Val(Lab_BillId.Caption)
        Set Rectemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
        With Rectemp
            If Not .EOF Then
                '[>>显示单据
                TextChangeLock = True     '文本框加锁
                LrText(0).Text = Trim(.Fields("mnumber") & "")                              '物料编码
                LrText(1).Text = Trim(.Fields("mName") & "")                                '物料名称
                LrText(2).Text = Trim(.Fields("Model") & "")                                '规格型号
                LrText(3).Text = Trim(.Fields("PurUnitName") & "")                          '计量单位
                LrText(4).Text = Trim(.Fields("SupplierName") & "")                         '供应商名称
                LrText(5).Text = Trim(.Fields("Quantity") & "")                             '数量
                LrText(6).Text = Format(Trim(.Fields("PurReciptDate") & ""), "yyyy-mm-dd")  '进料日期
                LrText(7).Text = Trim(.Fields("AreaName") & "")                             '产地名称
                LrText(8).Text = Format(Trim(.Fields("stoCheckDate") & ""), "yyyy-mm-dd")   '检验日期
                LrText(9).Text = Trim(.Fields("gradename") & "")                            '质量等级
                LrText(10).Text = Trim(.Fields("cgsy") & "")                                '采购质量和事由
                LrText(11).Text = Trim(.Fields("zgyj") & "")                                '总工程师意见
                LrText(12).Text = Trim(.Fields("zgzl") & "")                                '主管领导指令
                LrText(13).Text = Trim(.Fields("sccyj") & "")                               '生产技术处使用意见
                LrText(15).Text = Trim(.Fields("Maker") & "")                               '制单人
                LrText(16).Text = Trim(.Fields("Checker") & "")                             '审核人
                LrText(17).Text = Trim(.Fields("stockchecknum") & "")                       '单据号
                
                Cbo_Result.Clear                                                            '质量等级
                Cbo_Result.AddItem "是"
                Cbo_Result.AddItem "否"
                If Trim(.Fields("ifuse") & "") = "1" Then
                    Cbo_Result.ListIndex = 0
                    LrText(14).Text = "是"
                Else
                    Cbo_Result.ListIndex = 1
                    LrText(14).Text = "否"
                End If
                TextChangeLock = False    '文本框解锁
                '<<]
            End If
        End With
        
        '设置审核弃审按钮状态
        Call Sub_CheckStatus
        
    End If
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
        Me.Cbo_Result.Enabled = True
    Else
        For Jsqte = Max_Text_Index To 0 Step -1
            LrText(Jsqte).Enabled = False
        Next Jsqte
        Me.Cbo_Result.Enabled = False
    End If
    
End Sub

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

Private Sub Sub_AddBill()                                                '新增一张单据
    
    Dim Rectemp As New ADODB.Recordset            '临时使用动态集
    Dim Jsqte As Long                             '临时计数器
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
     If Not Security_Log(Str_RightEdit, 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
    
    '[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
    LrText(15).Text = Xtczy
    LrText(16).Text = ""
    '<<]
    
    '让第一个录入项得到焦点(Fixed)
    On Error Resume Next
    LrText(10).SetFocus
    
End Sub

Private Sub Sub_EditBill()                                                '修改一张单据
    
    Dim Rectemp As New ADODB.Recordset     '临时使用动态集
    
     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
     If Not Security_Log(Str_RightEdit, 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(15).Text = Xtczy
    
    '让第一个录入项得到焦点
    On Error Resume Next