VB开发的ERP系统

  
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    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
    
    '已使用字段不能删除
    Dim str As String
    Set rstemp = New ADODB.Recordset
    str = "select * from gdzc_Custom where fieldCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'"
    rstemp.Open str, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        If rstemp.Fields("whetherNull") = True Then
            Tsxx = "该属性已被使用，不能删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    '用户确认是否删除记录
    Tsxx = "请确认是否删除当前记录?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
    
    If yhAnswer = 2 Then
        Exit Sub
    End If

    On Error GoTo Cwcl
    Cw_DataEnvi.DataConnect.BeginTrans

    '[>>以下需自定义部分
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select * from gdzc_Custom where fieldcode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        rstemp.Delete
        rstemp.Update
    End If
    rstemp.AddNew
    rstemp!FieldCode = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))
    rstemp!field_index = CzxsGrid.Row
    rstemp.Update
    rstemp.Close
    Set rstemp = Nothing
    
    Cw_DataEnvi.DataConnect.Execute ("alter table Gdzc_card drop column " & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))))
    Cw_DataEnvi.DataConnect.Execute ("alter table Gdzc_cardtemp drop column " & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))))
    
    '修改录入文本框属性
    Set rstemp = New ADODB.Recordset
    rstemp.Open "SELECT * From Xt_text_input WHERE system_code = 'gdzc' AND text_group_code = 'gdzc_cardjbcz' and text_name='自定义" & CzxsGrid.Row & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        rstemp.Fields("Text_data_type") = 0
        rstemp.Fields("Text_Length") = 0
        rstemp.Fields("judge_type") = 0
        rstemp.Update
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    '以上为自定义部分<<]
  
    Cw_DataEnvi.DataConnect.CommitTrans

    CzxsGrid.RemoveItem CzxsGrid.Row

    Exit Sub
  
Cwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    
    Tsxx = "出现未知情况,该编码不能被删除!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub

'*******************以下区域为编写自定义过程区域**********************
'    '判断系统是否最大自定义数量
Function Judge_Num() As Boolean
    
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select * from Gdzc_Custom where FieldState='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If rstemp.EOF Then
        Judge_Num = False
    Else
        Judge_Num = True
    End If
    rstemp.Close
    Set rstemp = Nothing

End Function

'根据用户选择的数据类型，决定lrtext是否可以编辑的属性
Private Sub Com_DataType_Click()

    Select Case Trim(Com_DataType.Text)
        Case "字符型"
            LrText(1).Enabled = True
            LrText(2).Enabled = False
            LrText(3).Enabled = False
        Case "整数型"
            LrText(1).Enabled = True
            LrText(2).Enabled = False
            LrText(3).Enabled = False
        Case "小数型"
            LrText(1).Enabled = False
            LrText(2).Enabled = True
            LrText(3).Enabled = True
        Case "货币型"
            LrText(1).Enabled = False
            LrText(2).Enabled = False
            LrText(3).Enabled = False
        Case "日期型"
            LrText(1).Enabled = False
            LrText(2).Enabled = False
            LrText(3).Enabled = False
    End Select
        
End Sub

Function Sqlcd() As String           '根据用户的自定义数据类型，传递Sql语句
    
    Dim str As Double
    str = Val(LrText(2).Text) + Val(LrText(3).Text) + 3
    If str = 1 Then str = 18
    Select Case Trim(Com_DataType.Text)
        Case "字符型"
            Sqlstr = "alter table Gdzc_Card add " & CodeTemp & " nchar(" & Trim(LrText(1).Text) & ") " & "NULL"
            SqlStr1 = "alter table Gdzc_Cardtemp add " & CodeTemp & " nchar(" & Trim(LrText(1).Text) & ") " & "NULL"
        Case "整数型"
            Sqlstr = "alter table Gdzc_Card add " & CodeTemp & " int NULL"
            SqlStr1 = "alter table Gdzc_Cardtemp add " & CodeTemp & " int NULL"
        Case "小数型"
            Sqlstr = "alter table Gdzc_Card add " & CodeTemp & " decimal(" & str & "," & Trim(LrText(3).Text) & ") " & "NULL"
            SqlStr1 = "alter table Gdzc_Cardtemp add " & CodeTemp & " decimal(" & str & "," & Trim(LrText(3).Text) & ") " & "NULL"
        Case "货币型"
            Sqlstr = "alter table Gdzc_Card add " & CodeTemp & " money NULL"
            SqlStr1 = "alter table Gdzc_Cardtemp add " & CodeTemp & " money NULL"
        Case "日期型"
            Sqlstr = "alter table Gdzc_Card add " & CodeTemp & " datetime NULL"
            SqlStr1 = "alter table Gdzc_Cardtemp add " & CodeTemp & " datetime NULL"
    End Select

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 SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
                    Call Toolbjzt
                    Lrzt = 1
                    Call Cshlrxx(Lrzt)
                    LrText(0).SetFocus
                    LrText(0).Locked = False
                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).SetFocus
            LrText(0).Locked = False
        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(0).SetFocus
        LrText(0).Locked = True
    End If
    Com_DataType_Click
    
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()       '保 存
    
    Dim i As Integer         '自定义数变量

    '判断是否达到系统所支持最大数量
    If Judge_Num = False Then
        Tsxx = "系统所支持的自定义数量已经达到极限!"
        Call Xtxxts(Tsxx, 0, 4)
        Call Cancel
        Exit Sub
    End If

    If Trim(LrText(0).Text) = "" Then
        Tsxx = "定义名称不能为空!"
        Call Xtxxts(Tsxx, 0, 1)
        LrText(0).SetFocus
        Exit Sub
    End If
    
    Select Case Com_DataType.Text
        Case "字符型"
            If Val(LrText(1).Text) > 2000 Then
                Tsxx = "数据长度超长!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Exit Sub
            End If
            If LrText(1).Text = "" Then
                Tsxx = "字段长度不能为空!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Exit Sub
            End If
        Case "整数型"
            If Val(LrText(1).Text) > 6 Then
                Tsxx = "字段长度不能超长!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Exit Sub
            End If
        Case "小数型"
            If Val(LrText(2).Text) > 18 Then
                Tsxx = "整数位数超长!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(2).SetFocus
                Exit Sub
            End If
            If Val(LrText(3).Text) > 6 Then
                Tsxx = "小数位数超长!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(3).SetFocus
                Exit Sub
            End If
            If LrText(2).Text = "" Then
                Tsxx = "整数位数不能为空!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(2).SetFocus
                Exit Sub
            End If
            If LrText(3).Text = "" Then
                Tsxx = "小数位数不能为空!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(3).SetFocus
                Exit Sub
            End If
    End Select
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    On Error GoTo Cwcl
    
    If Lrzt = 1 Then                '增加
        
        '有效性判断
        Set rstemp = New ADODB.Recordset
        rstemp.Open "select * from Gdzc_custom where FieldName='" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not rstemp.EOF Then
            Tsxx = "属性名称重复!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(0).Text = ""
            LrText(0).SetFocus
            Cw_DataEnvi.DataConnect.RollbackTrans
            Exit Sub
        End If
        rstemp.Close
        Set rstemp = Nothing

        '修改辅助表
        Set rstemp = New ADODB.Recordset
        rstemp.Open "select top 1 * from gdzc_custom where fieldState='0' ORDER BY Field_Index", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not rstemp.EOF Then
            With rstemp
                CodeTemp = .Fields("FieldCode")
                .Fields("FieldName") = Trim(LrText(0).Text)
                Select Case Com_DataType.Text
                    Case "字符型"
                        .Fields("Datatype") = 1
                    Case "整数型"
                        .Fields("Datatype") = 2
                    Case "小数型"
                        .Fields("Datatype") = 3