VB开发的ERP系统

    Call Sjcsh(Trim(Lab_Djclzt.Caption))
    
End Sub

Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
    
    '是否保存已修改单据
     Dim YAnswer As Integer
     If Lab_OperStatus.Caption = "2" Or Lab_OperStatus.Caption = "3" Then
         Tsxx = "单据尚未保存,是否退出?"
         YAnswer = Xtxxts(Tsxx, 2, 2)
         If YAnswer <> 1 Then
             Cancel = 1
             Exit Sub
         End If
     End If
    
    '卸载打印页面窗体
    Unload Dyymctbl
    
    '判断单据是否发生变化,并返回相应标识
    If Bln_BillChange Then
        Xtfhcs = "1"
    Else
        Xtfhcs = "0"
    End If
    
End Sub

Private Sub Sjcsh(Str_Pzclzt As String)              '数据初始化模块(根据实际情况)
    
    Dim Sqlstr As String       '查询单据列表条件
    
    '[>>根据实际情况初始化
    Select Case Str_Pzclzt
    Case "1"   '填制单据
        '调入用户查询结果动态集(默认显示全部单据)
        Sqlstr = "SELECT Distinct ReportDate From Qc_GasReport "
        Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        
        '新增单据
        Call Sub_AddBill
    
    
    End Select
    
    '<<]
    
End Sub

Private Sub Sub_ShowBill()                                          '根据当前单据日期显示整张单据内容
    
    '过程默认参数为当前窗体中单据日期:Lab_BillID
    Dim Sqlstr As String                           '临时使用字符串
    Dim RecTemp As New ADODB.Recordset             '临时使用动态集
    Dim Jsqte As Long                              '临时计数器
    
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    WglrGrid.Redraw = False
    
    '本张单据查询字符串
    Sqlstr = "SELECT * From Qc_V_GasReport Where ReportDate='" & Trim(Lab_BillId.Caption) & "' Order By ItemID"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        
        If .EOF Then
            WglrGrid.Redraw = True
            Exit Sub
        Else
            '[>>显示单据头
            TextChangeLock = True     '文本框加锁
            LrText(0).Text = Format(.Fields("ReportDate"), "yyyy-mm-dd")                  '取样日期
            LrText(1).Text = Trim(.Fields("Remark") & "")                                '制单人
            TextChangeLock = False    '文本框解锁
            '<<]
        End If
        WglrGrid.Rows = WglrGrid.FixedRows
        Jsqte = WglrGrid.FixedRows
        Do While Not .EOF
            WglrGrid.AddItem ""
            '[>>显示单据分录
            WglrGrid.TextMatrix(Jsqte, 0) = "*"                                                                         '数据有效行标识(必填)
            WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("ItemId") & "")                                              '采样点代码
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ItemName") & "")                  '采样点名称
            WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("CL") & "")                     '氯气
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("HCL") & "")                    '氯化氢
            WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("NH") & "")                  '氨气
            WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("SO") & "")                    '二氧化硫
            WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("HS") & "")                    '硫化氢
            WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("A1") & "")                  '备用1
            WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("A2") & "")                    '备用2
            '<<]
            
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    
    
    '调整网格(Fixed)
    Call Sub_AdjustGrid
    
    
    '将网格刷新解禁(Fixed)
    WglrGrid.Redraw = True
    
    
    
End Sub



Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
    
    '屏蔽文本框,下拉组合框有效性判断
    Valilock = True
    
    '屏蔽网格失去焦点产生的有效性判断
    Changelock = True
    
    Select Case Button.Key
    Case "yl"                                            '预 览
        If Fun_Drfrmyxxpd Then
            BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False
        End If
    Case "dy"                                            '打 印
        If Fun_Drfrmyxxpd Then
            Dim yhAnswer As Integer      '打印提示
            
            '用户确认是否打印单据
            Tsxx = "请确认是否打印当前单据?"
            yhAnswer = Xtxxts(Tsxx, 2, 2)
            If yhAnswer = 2 Then
                Exit Sub
            End If
            BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True
        End If
    Case "xz"                                            '新 增
        Call Sub_AddBill
    Case "xg"                                            '修 改
        Call Sub_EditBill
    Case "sc"                                            '删 除
        Call Sub_DeleteBill
   
    Case "bc"                                            '保 存
        If Fun_Drfrmyxxpd Then
            Call Sub_SaveBill
        End If
    Case "fq"                                            '放 弃
        Call Sub_AbandonBill
    Case "find"                                            '查 询
        Call Drbmhelp(0, "Qc_GasCheckHelp", "")
        Lab_BillId.Caption = Xtfhcs
        Call Sub_ShowBill
    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
            If Fun_Drfrmyxxpd 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("find").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_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("find").Enabled = False    '查询
            .Buttons("bc").Enabled = True       '保存
            .Buttons("fq").Enabled = True       '放弃
            .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("find").Enabled = False    '查询
            .Buttons("bc").Enabled = True       '保存
            .Buttons("fq").Enabled = True       '放弃
            .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 Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    
    Dim xswbrr As String
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
        If GridBoolean(.Col, 3) Then   '列表框录入
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            Wbkbhlock = True
            
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
            
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With
    
End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
    
    '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
    
    Dim Str_JudgeText As String                 '临时有效性判断字段内容
    Dim Coljsq As Long                          '临时列计数器
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Sqlstr As String                        '临时使用查询字符串
    
    With WglrGrid
        '非录入状态或非数据行则其有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            '[>>以下为自定义部分
            Case "002"                   '氯气
                If Trim(.TextMatrix(Dqpdwgh, 1)) = "" Then
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""
                    .TextMatrix(Dqpdwgh, 0) = ""
                End If