+

VB开发的ERP系统

    If Shift = 2 Then         'Ctrl的位屏蔽值=2
        Select Case UCase(Chr(KeyCode))
            Case "P"          'Ctrl+P 打印
                If Tlb_Action.Buttons("dy").Enabled Then Call bbyl(False)
        End Select
    End If
    Select Case KeyCode
        Case vbKeyF3          '修改
            If Tlb_Action.Buttons("xg").Enabled Then
                Call Sub_EditBill
            End If
        Case vbKeyF6          '保存
            If Tlb_Action.Buttons("bc").Enabled 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("xg").Enabled = False     '修改
                .Buttons("zh").Enabled = False     '增行
                .Buttons("sh").Enabled = False     '删行
                .Buttons("bc").Enabled = False     '保存
                .Buttons("fq").Enabled = False     '放弃
            Case "11"   '浏览
                 '工具条
                .Buttons("dy").Enabled = True      '打印
                .Buttons("yl").Enabled = True      '预览
                .Buttons("xg").Enabled = True      '修改
                .Buttons("zh").Enabled = False     '增行
                .Buttons("sh").Enabled = False     '删行
                .Buttons("bc").Enabled = False     '保存
                .Buttons("fq").Enabled = False     '放弃
            Case "30"   '修改
                '工具条
                .Buttons("dy").Enabled = False      '打印
                .Buttons("yl").Enabled = False      '预览
                .Buttons("xg").Enabled = False      '修改
                .Buttons("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
        End Select
    End With
End Sub
Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
    Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
    
    '如果单据操作状态为浏览状态则不能显示录入载体
    If Trim(Lab_OperStatus.Caption) = "1" Then Exit Sub
    
    '显示文本框前返回有效行列（解决滚动条问题）
    Call Xldqh
    Call Xldql
    
    '隐藏文本框,帮助按钮,列表组合框
    Call Ycwbk
    
    With WglrGrid
        Dqlrwgh = .Row
        Dqlrwgl = .Col
        If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then Exit Sub
        Wbkpy = 30
        Wbkpy1 = 15
        If GridBoolean(.Col, 3) Then            '若是下拉列表录入
            YdCombo.Left = .CellLeft + .Left + Wbkpy
            YdCombo.Top = .CellTop + .Top + Wbkpy
            YdCombo.Width = .CellWidth - Wbkpy1
            Call Wbkcl                          '主要是在下拉列表框可用之前填充下拉列表框
            YdCombo.Visible = True
            YdCombo.SetFocus
            Ydcommand.Visible = False
            Ydtext.Visible = False
        Else
            If GridBoolean(.Col, 2) Then        '是否提供帮助
                Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
                Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
                Ydcommand.Visible = True
            Else
                Ydcommand.Visible = False
            End If
            Ydtext.Left = .CellLeft + .Left + Wbkpy
            Ydtext.Top = .CellTop + .Top + Wbkpy
            If Ydcommand.Visible Then
                If Sfblbzkd Then
                    Ydtext.Width = .CellWidth - Ydcommand.Width
                Else
                    Ydtext.Width = .CellWidth - Wbkpy1
                End If
            Else
                Ydtext.Width = .CellWidth - Wbkpy1
            End If
            Ydtext.Height = .CellHeight - Wbkpy1
            If GridInt(.Col, 2) <> 0 Then
                Ydtext.MaxLength = GridInt(.Col, 2)
            Else
                Ydtext.MaxLength = 3000
            End If
             ' 主要是Zdlrqnr = Trim(.Text)即将网格单元的内容赋予文本框，并且记录网格编辑之前的内容
             '为是否对该单元的内容进行字段有效判断加锁Yxxpdlock = False
            Call Wbkcl
            Ydtext.Visible = True
            Ydtext.SetFocus
        End If
        Dqtoprow = .TopRow
        Dqleftcol = .LeftCol
        
        '重置锁值
        Valilock = False
        Wbkbhlock = False
    End With
End Sub
Private Function Fun_AllowInput() As Boolean                           '当某种条件成立时禁止文本框激活使单据处于录入状态
    
    '如果单据操作状态为浏览状态则不能显示录入载体(通用)
    If Trim(Lab_OperStatus.Caption) = "1" Then
        Exit Function
    End If
    
    '[>>
    
    '此处可以填写禁止文本框激活使单据处于录入状态的理由
    
    '<<]
    
    Fun_AllowInput = True
    
End Function

Private Sub Lrsjhx()                                                   '文本框录入数据回写
    With WglrGrid
        If YdCombo.Visible Then .Text = Trim(YdCombo.Text)
        If Ydtext.Visible Then .Text = Trim(Ydtext.Text)
        
        '(如果字段录入内容发生变化,则打开有效性判断锁)
        If Zdlrqnr <> Trim(.Text) Then
            Yxxpdlock = False
            Hyxxpdlock = False
        End If
        '如果字段录入内容不为空则写数据行有效性标志
        If Len(Trim(.Text)) <> 0 Then
            Call Xyxhbz(.Row)
        End If
        '隐藏文本框,帮助按钮,列表组合框
        Call Ycwbk
    End With
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)        '录入数据字段有效性判断,同时进行字段录入事后处理
    Dim Str_JudgeText As String  '临时有效性判断字段内容
    Dim Coljsq As Long           '临时列计数器
    With WglrGrid
        '非录入状态有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
    End With
    
    Select Case GridStr(Dqpdwgl, 1)
        '以下为自定义部分[
        Case "001"          '项目编码
            If Len(Str_JudgeText) <> 0 Then
                
                '取项目名称
                SqlStr = "SELECT ItemName FROM Cb_CostItem Where ItemCode='" & Str_JudgeText & "'"
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                If Not RecTemp.EOF Then
                    WglrGrid.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("ItemName"))
                Else
                    Tsxx = "项目编码不存在,请重新输入!"
                    GoTo Lrcwcl
                End If
            End If
        Case "003"     '计算公式
        '以上为自定义部分]
    End Select
    
    '字段录入正确后为零字段清空
    Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    sjzdyxxpd = True
    Yxxpdlock = True
    Exit Function
Lrcwcl:    '录入错误处理
    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        If GridBoolean(.Col, 1) = True Then
            Changelock = False
            Call xswbk
            sjzdyxxpd = False
        End If
    End With
    Exit Function
End Function
Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
    Dim Lrywlz As Long
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Bln_AssVali As Boolean             '辅助核算错误
    Dim Bj As Boolean                      '辅助项有效性标志
    Dim Rowjsq As Long

    With WglrGrid
        '判断行是否为空和无效数据行清除
        If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
        If .TextMatrix(Yxxpdh, 0) <> "*" Then
            Sjhzyxxpd = True
            Exit Function
        Else
            If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
                If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
                    Changelock = True
                    .RemoveItem Yxxpdh
                    If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                    .AddItem ""
                    .RowHeight(.Rows - 1) = Sjhgd
                    End If
                    Changelock = False
                    Sjhzyxxpd = True
                    Exit Function
                End If
            End If
        End If
        
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
  
        '以下为自定义部分[
        '1.放置行有效性判断程序

        '首先进行为空判断(固定不变)
        For jsqte = Qslz To .Cols - 1
            If (GridInt(jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0) Or (GridInt(jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0) Then
                Tsxx = GridStr(jsqte, 2)
                Lrywlz = jsqte
                GoTo Lrcwcl
                Exit For
            End If
        Next jsqte
        
        '判断此编码是否存在
        For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
            If Rowjsq <> Yxxpdh Then
                If Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls))) Then
                    Tsxx = "项目编码重复,请重新输入!"
                    Lrywlz = Sydz("001", GridStr(), Szzls)
                    GoTo Lrcwcl
                End If
            End If
        Next
        
        '2.放置行处理程序
      
        '以上为自定义部分]
    End With
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function
Lrcwcl:      '录入错误处理
    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False
        Sjhzyxxpd = False
        Exit Function
    End With
End Function
Private Sub Sub_EditBill()                                                '修改
    '判断当前凭证是否允许修改
    If Not Fun_AllowEdit Then
        Exit Sub
    End If
        
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    '设置操作状态为修改
    Lab_OperStatus.Caption = "3"
    '设置工具条状态
    Call Sub_OperStatus("30")
End Sub
Private Sub Sub_AbandonBill()                                              '放弃

    '先关闭录入载体
    Changelock = True
    Valilock = True
    Call Ycwbk
    Changelock = False
    Valilock = False
    Select Case Trim(Lab_OperStatus.Caption)
        Case "3"         '修改状态
            '重新显示当前单据
            Call Sub_Query
            '设置操作状态为浏览
            Lab_OperStatus = "1"
            Call Sub_OperStatus("11")
    End Select
End Sub
Private Function Fun_AllowEdit() As Boolean                      '判断当前定义是否允许编辑或删除
    Fun_AllowEdit = True
End Function
'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='