VB开发的ERP系统

            '先查询出同车号各状态已完成的记录并找出最大时间与填入记录进行判断
            str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=1 order by BeginTime      "
            Set rs_Tmp = Nothing
            Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
            If Not rs_Tmp.RecordCount = 0 Then
                 ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 3)
            End If
            k = 0
            Do While Not rs_Tmp.EOF()
                arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
                arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
                arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
                arrVar_TableCon2(k, 3) = rs_Tmp.Fields("VoucherId")
                rs_Tmp.MoveNext
                k = k + 1
            Loop
            
            str_tmp = "select * from Tr_Weigh where WeighId='" & dbl_RecordAutoCode & "'and result=1 order by WeighEndTime      "
            Set Findrec = Nothing
            Set Findrec = Cw_DataEnvi.DataConnect.Execute(str_tmp)
                    If Not Findrec.RecordCount = 0 Then
                      If CDate(Findrec.Fields("WeighEndTime")) = arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
                        If JiText(1).Text = "____-__-__ __:__" Then
                            If JiText(0).Text = arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 1) Then
                                JiTextptpd = True
                                Exit Function
                            End If
                        End If
                      End If
                    End If
            If Not rs_Tmp.RecordCount = 0 Then
                If JiText(0).Text < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
                    If Trim(JiText(1).Text) = "____-__-__ __:__" Then
                        Tsxx = "检斤完毕时间不能为空"
                        Call Xtxxts(Tsxx, 0, 1)
                        JiText(1).SetFocus
                        JiTextptpd = False
                        Exit Function
                    End If
                End If
                For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
                    If JiText(0) >= arrVar_TableCon2(i, 1) And JiText(0).Text <= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
                        Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                        Call Xtxxts(Tsxx, 0, 1)
                        JiText(0).SetFocus
                        JiTextptpd = False
                        Exit Function
                    End If
                    If JiText(1) >= arrVar_TableCon2(i, 1) And JiText(1).Text <= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
                        Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                        Call Xtxxts(Tsxx, 0, 1)
                        JiText(1).SetFocus
                        JiTextptpd = False
                        Exit Function
                    End If
                    If JiText(0) <= arrVar_TableCon2(i, 1) And JiText(1).Text >= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
                        Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                        Call Xtxxts(Tsxx, 0, 1)
                        JiText(1).SetFocus
                        JiTextptpd = False
                        Exit Function
                    End If
                Next i
            End If
            
            
'    End If
    
       
End If
       JiTextptpd = True
       Exit Function
Pdbz:
      Tsxx = "出现未知错误!"
     Call Xtxxts(Tsxx, 0, 1)
     JiTextptpd = False
     Exit Function
   
End Function


'*******************以上区域为编写自定义过程区域**********************

'******************以下为基本处理程序(固定不变)************************'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作

    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
            Case "P"                                                                          'Ctrl+P 打印
                If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
                    Call bbyl(False)
                End If
            Case "A"                                                                          'Ctrl+A 增加
                '判断用户是否有此功能执行权限,如有则写上机日志(进入)
                If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
                    Exit Sub
                End If
                If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
                    Call Toolbjzt
                    Lrzt = 1
                    Call Cshlrxx(Lrzt)
                    LrText(0).Enabled = True
                    LrText(0).SetFocus
                End If
            Case "D"                                                                          'Ctrl+D 删除
                If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
                    Call Scdqjl
                End If
        End Select
    End If
    
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
   
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
        Case "dy"                                            '打 印
            Call bbyl(False)
        Case "zj"                                            '增 加
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
                Exit Sub
            End If
            Call Toolbjzt
            Lrzt = 1
            Call Cshlrxx(Lrzt)
            LrText(0).Enabled = True
            LrText(0).SetFocus
            Ydcommand1(0).Enabled = True
           
        Case "xg"                                            '修 改
            Call Xgdqjl
        Case "sc"                                            '删 除
            Call Scdqjl
        Case "sx"                                            '刷 新
            Call Cxnrtcwg
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
        End Select
        
End Sub

Private Sub CzxsGrid_DblClick()                            '修改当前编码记录

    Call Xgdqjl
  
End Sub

Private Sub Xgdqjl()                                       '修改当前编码记录
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
        BcCommand.Enabled = False
    End If
    
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
    
    Call Toolbjzt
    Lrzt = 2
    
    If Cshlrxx(Lrzt) Then
        LrText(1).SetFocus
        LrText(0).Enabled = False
        Ydcommand1(0).Enabled = False
        
    End If
  
End Sub

Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)

    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    Frame1.Enabled = True
    StTab.TabEnabled(0) = False
    CzxsGrid.Enabled = False

    With SzToolbar
        .Buttons("ymsz").Enabled = False
        .Buttons("dy").Enabled = False
        .Buttons("yl").Enabled = False
        .Buttons("zj").Enabled = False
        .Buttons("xg").Enabled = False
        .Buttons("sc").Enabled = False
        .Buttons("sx").Enabled = False
    End With
  
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)

    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    CzxsGrid.Enabled = True
    Frame1.Enabled = False
    StTab.TabEnabled(1) = False
    Lrzt = 0
    
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True
        .Buttons("zj").Enabled = True
        .Buttons("xg").Enabled = True
        .Buttons("sc").Enabled = True
        .Buttons("sx").Enabled = True
    End With
  
End Sub

Private Sub BcCommand_Click()                                           '保 存

    If Not Bclrsj Then
        Exit Sub
    End If
  
    If Lrzt = 2 Then
        Call Toolfbjzt
    End If
  
End Sub

Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)       '取消
  
    '避免执行Click程序
    Bln_Cancel = True
  
    Call Cancel
    
End Sub

Private Sub QxCommand_Click()                                                                         '取消
 
    If Bln_Cancel Then
        Bln_Cancel = False
        Exit Sub
    End If
 
    Call Cancel
    
End Sub

Private Sub Cancel()                                                                                  '取消
  
    '文本框加锁
    For jsqte = 0 To Max_Text_Index
        TextValiJudgeLock(jsqte) = True
    Next jsqte
  
    Call Toolfbjzt
    
End Sub

Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    
    FnBln_RefreshArray Col, Position, GridStr(), GridInf()

End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
    
    Select Case Button.Key
        Case "bcgs"                                       '保存表格格式
            Call Bcwggs(CzxsGrid, GridCode, GridStr())
        Case "hfmrgs"                                     '恢复默认格式
            Call Hfmrgs(CzxsGrid, GridCode, GridStr())
        Case "szxsxm"                                     '设置显示项目
            Call Szxsxm(CzxsGrid, GridCode)
    End Select
    
End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览

    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    
    Bbzbt = ReportTitle
    Bbxbt(1) = " "
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    
    Call Scyxsjb(CzxsGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
    
End Sub

'************以下为文本框录入处理程序(固定不变部分)********