+

VB开发的ERP系统

            If .ItemType = 0 Then
                Cbo_DataType = "字符型"
            ElseIf .ItemType = 5 Then
                Cbo_DataType = "数值型"
            End If
        Else
            Singl = False
            Cbo_DataType.Enabled = True
        End If
        
    End With
End Sub

Private Sub Cmd_Save_Click()
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    Sql = ""
    
    With CzxsGrid
        If .Rows > .FixedRows Then
            For i = .FixedRows To .Rows - 1
                Sql = Sql & " update PM_BankItem set OrderNO=" & _
                      i & _
                      " where sortid='" & SortId & _
                      "' and BankCode='" & BankCode & "'" & _
                      " and Id=" & _
                      .TextMatrix(i, 0)
            Next
        Else
           Call Xtxxts("没有栏目，无需保存!", 0, 1)
           Exit Sub
        End If
    End With
    On Error GoTo Err1
    Cw_DataEnvi.DataConnect.BeginTrans
    Cw_DataEnvi.DataConnect.Execute Sql
    Cw_DataEnvi.DataConnect.CommitTrans
    Call Xtxxts("顺序保存成功!", 0, 4)
    Call Cxnrtcwg
    Exit Sub
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Call Xtxxts("顺序保存不成功!", 0, 1)
End Sub

Private Sub Cmd_Up_Click()
    With CzxsGrid
        If .Row <= .FixedRows Then
           Exit Sub
        End If
    End With
    Call CmdUP(CzxsGrid)
End Sub

Private Sub Cmd_Down_Click()
    With CzxsGrid
        If .Row = .Rows - 1 Then
            Exit Sub
        End If
    End With
    Call CmdDown(CzxsGrid)
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移

    jdzygs = 10
    
    Select Case KeyAscii
        Case vbKeyReturn
            If Kjjdzy(jdzygs) Then
                KeyAscii = 0
            End If
        Case 39           '屏蔽"'"
            KeyAscii = 0
   End Select
   
End Sub

Private Sub Form_Load()
  
    '打印报表标题信息
    ReportTitle = "银行代发栏目"
     
    '调入打印页面设置窗体
    XtReportCode = "PM_BankItem"
    Load Dyymctbl
    
    '以下为文本框处理程序(读入文本框录入信息)
    TextGroupCode = "PM_BankItem"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())
    Call Wbkcsh
    
    '调入网格设置信息
    GridCode = "PM_BankItem"
    Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Szzls = CzxsGrid.Cols - 1
    
    CzxsGrid.TextMatrix(0, 0) = "ID号"
    Sql = " and czybm='" & Xtczybm & "'"
    ImgCbo_Sort.Text = ""
    ImgCbo_Bank.Text = ""
    Call DynaFillImageCombo(ImgCbo_Sort, "pm_SortEmp", 0, Sql)
    Call FillImageCombo(ImgCbo_Bank, "pm_BankItem", 0)
    SortId = GetComboKey(ImgCbo_Sort, 0)
    BankCode = GetComboKey(ImgCbo_Bank, 0)
    EC
    
    Call FillCombo(Cbo_DataType, "PM_BankItem", "", 0)
    '填 充 网 格
    Call Cxnrtcwg
       
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
    Frame1.Enabled = False
     
    '设置为非录入状态
    Lrzt = 0
    '编辑(新增、修改、删除)权限索引
    Str_RightEdit = "Pm_BankItem_Edit"
    
End Sub
 
Private Sub Cxnrtcwg()                               '查询内容填充网格

    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                 '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结
    CzxsGrid.Redraw = False
  
    '[>>查询连接串
    Sqlstr = "SELECT p.*,r.ChName FROM PM_BankItem  p left join rs_items r on right(ltrim(rtrim(sourcefield)),len(ltrim(rtrim(sourcefield)))-charindex('.',ltrim(rtrim(sourcefield))))=r.fieldname where BankCode='" & _
             BankCode & "' and SortID='" & SortId & "' order by OrderNO"
             
    '<<]
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With Cxnrrec
        CzxsGrid.Rows = CzxsGrid.FixedRows
        If .EOF And .BOF Then
            CzxsGrid.Redraw = True
            If Trim(SortId) <> "" And Trim(BankCode) <> "" Then
                SzToolbar.Buttons("import").Enabled = True
            Else
                SzToolbar.Buttons("import").Enabled = False
            End If
            Exit Sub
        End If
        
        jsqte = CzxsGrid.FixedRows
        
        Do While Not .EOF
            CzxsGrid.AddItem ""
            Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
            CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
  
    '将网格刷新动作解冻
    CzxsGrid.Redraw = True
    If CzxsGrid.Rows = CzxsGrid.FixedRows And Trim(SortId) <> "" And Trim(BankCode) <> "" Then
        SzToolbar.Buttons("import").Enabled = True
    Else
        SzToolbar.Buttons("import").Enabled = False
    End If
End Sub

Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格

    '[>>以下为自定义部分
    With Jlbrec
        CzxsGrid.TextMatrix(Rowjsq, 0) = .Fields("ID")             'ID号
        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Columnname") & "")            '栏目名称
        If .Fields("Single") = True Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("chName") & "")            '数据内容
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("DataContent") & "")            '数据内容
        End If
        If .Fields("Single") = True And Trim(.Fields("DataContent") & "") = "银行账号" Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("DataContent") & "")            '数据内容
        End If
        Select Case .Fields("DataType")
            Case 0
                CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = "字符型"
            Case 5
                CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = "数值型"             '数据类型
        End Select
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = .Fields("DataLen")            '数据长度
        CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = .Fields("DotLen")             '小数位数
        CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = .Fields("Single")           '来源型
        CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("BkRoundType") & "")            '括栏目符号
        CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = .Fields("AutoAdd1")             '自动加1
        CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = .Fields("OrderNO")             '自动加1
    End With
    '以上为自定义部分<<]
    
End Sub
Private Sub toolEnable()
    With SzToolbar
        .Buttons("zj").Enabled = True
        .Buttons("xg").Enabled = True
        .Buttons("sc").Enabled = True
        .Buttons("sx").Enabled = True
    End With
    Cmd_Up.Enabled = True
    Cmd_Down.Enabled = True
    Cmd_Save.Enabled = True
End Sub
Private Sub toolUnEnable()
    With SzToolbar
        .Buttons("zj").Enabled = False
        .Buttons("xg").Enabled = False
        .Buttons("sc").Enabled = False
        .Buttons("import").Enabled = False
        .Buttons("sx").Enabled = False
    End With
    Cmd_Up.Enabled = False
    Cmd_Down.Enabled = False
    Cmd_Save.Enabled = False
End Sub
Private Sub EC()
    If Trim(ImgCbo_Sort.Text) = "" Or Trim(ImgCbo_Bank.Text) = "" Then
        toolUnEnable
    Else
        toolEnable
    End If
    
End Sub
Private Sub Form_Unload(Cancel As Integer)             '窗体卸载

    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Set Rsc = Nothing
    Unload Dyymctbl
   
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

    Dim jsqte As Integer
    Dim SIntC As Integer  '非来源型整数部分的位数
    Dim SDotC As Integer  '非来源型小数部分的位数
  
    '对文本框录入内容进行为零和为空判断(固定不变)
    With Rec_CodeSet
    
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 8) = 1 Then     '字段不能为空
                If Len(Trim(LrText(jsqte).Text)) = 0 Then
                    Tsxx = Textstr(jsqte, 7) & "不能为空!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(jsqte).SetFocus
                    Bclrsj = False
                    Exit Function
                End If
            Else
                If Textint(jsqte, 8) = 2 Then   '字段不能为零
                    If Val(Trim(LrText(jsqte).Text)) = 0 Then
                        Tsxx = Textstr(jsqte, 7) & "不能为零!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(jsqte).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            End If
        Next jsqte
    
        '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
                If Not TextYxxpd(jsqte) Then
                    Exit Function
                End If
            End If
        Next jsqte
        
        If Trim(Cbo_DataType.Text) = "数值型" And Not IsNumeric(LrText(1)) And Singl = 0 Then
            Call Xtxxts("数值型栏目的数据内容必须是数字!", 0, 1)
            Bclrsj = False
            Exit Function
        End If
        
        If Trim(Cbo_DataType.Text) = "字符型" And Val(LrText(3)) <> 0 Then
            Call Xtxxts("字符型栏目的小数位数必须等于零!", 0, 1)
            Bclrsj = False
            Exit Function
        End If
        
        If Chk_Add.Value = 1 And Not IsNumeric(LrText(1)) Then
            Call Xtxxts("只有数据内容文本框的内容全部是数字时，自动加1才可被选中!", 0, 1)
            Bclrsj = False
            Exit Function
        End If
        
        If Trim(LrText(1)) = "银行账号" And Val(Trim(LrText(3))) > 50 Then
            Call Xtxxts("数据内容是银行账号时，数据长度不能超过50!", 0, 1)
            Bclrsj = False
            Exit Function
        End If
        If Val(LrText(3)) > Val(LrText(2)) Then
            Call Xtxxts("小数位数不能大于数据长度!", 0, 1)
            Bclrsj = False
            Exit Function
        End If
        
        If Singl = False And LenByte(Trim(LrText(1))) > Val(LrText(2)) Then
            Call Xtxxts("非来源型数据的数据内容的长度不能大于数据长度!", 0, 1)
            Bclrsj = False
            Exit Function
        End If
        
        If Singl = False And Cbo_DataType.Text = "数值型" Then
             If InStr(Trim(LrText(1)), ".") <> 0 Then     '小数
                 SIntC = InStr(Trim(LrText(1)), ".") - 1
                 SDotC = Len(Trim(LrText(1))) - InStr(Trim(LrText(1)), ".")
                 If SIntC > Val(LrText(2)) - Val(LrText(3)) - 1 Then
                    Call Xtxxts("非来源型数据的数据内容是数值型时它的整数长度不能大于设定的整数长度!", 0, 1)
                    Bclrsj = False
                    Exit Function
                 End If
                 
                 If SDotC > Val(LrText(3)) Then
                    Call Xtxxts("非来源型数据的数据内容是数值型时它的小数位数不能大于设定的小数位数!", 0, 1)
                    Bclrsj = False
                    Exit Function
                 End If
             End If
        End If
        
        If Lrzt = 1 Then  '增 加
        
            '[>>
            If .State = 1 Then .Close
            .Open "SELECT * FROM PM_BankItem WHERE BankCode= '" & BankCode & _
                  "' and SortId='" & SortId & "' and ColumnName='" & _
                  Trim(LrText(0)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
            If Not .EOF Then