设置_项目设置.frm

新世纪ERP设备管理源代码

        End Select
        CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Help_type
        If Trim(.Fields!YNRoot) = "0" Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = False
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = True
        End If
        If Trim(.Fields!YNJudge) = "0" Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = False
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = True
        End If
        If Trim(.Fields!yncode) = "0" Then
            CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = False
        Else
            CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = True
        End If
        
    End With
    '以上为自定义部分]

End Sub

Private Sub Form_Resize()
    
    On Error Resume Next
    
    If Me.Height < 5000 Then Me.Height = 5000
    If Me.Width < 8805 Then Me.Width = 8805
  
End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
    
    Set Cxnrrec = Nothing
    Unload Dyymctbl

End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
    
    Dim jsqte As Integer
    Dim Ssql As String
    Dim H_str As String
  
    If Trim(LrText(3).Text) = "" Then
        H_str = ""
    Else
        H_str = "CorrelationList"
    End If
  
    With RecDigest
        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 Textboolean(jsqte, 2) Then
                If Not TextYxxpd(jsqte) Then
                    Exit Function
                End If
            End If
        Next jsqte
    
        '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'        On Error GoTo Err_bc
        If Lrzt = 1 Then  '增 加
        
             If .State = 1 Then .Close
            .Open "SELECT * FROM DEV_Item WHERE ItemCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
            If Not .EOF Then
                Tsxx = "项目编码重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(0).SetFocus
                Bclrsj = False
                Exit Function
            End If

        
            If .State = 1 Then
                .Close
            End If
            .Open "SELECT * FROM DEV_Item WHERE ItemChineseName= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If .RecordCount > 0 Then
                RecDigest.Close
                Tsxx = "项目名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If
            RecDigest.Close
            
            Ssql = "insert into DEV_Item(ItemCode,ItemChineseName,ItemFieldName,ItemFieldType,ItmeFieldLength,ItmeCorrelation,YNcode,HelpType,YNJudge,TableName) " _
                    & "values('" & Trim(LrText(0).Text) & "','" & Trim(LrText(1).Text) & "','" _
                    & "a" & Trim(LrText(0).Text) & "','" & Com_Sort.ListIndex & "'," & Trim(LrText(2).Text) & ",'" & Trim(LrText(3).Text) & "','" _
                    & A_YNStop.Value & "','" & Combo_X.ListIndex & "','" & YN_Judge.Value & "','" & H_str & "' )"
            Cw_DataEnvi.DataConnect.Execute Ssql
   
            Ssql = "ALTER TABLE DEV_RootInfo ADD " & "a" & Trim(LrText(0).Text) & " NVARCHAR(50) NULL"
            Cw_DataEnvi.DataConnect.Execute Ssql
   
            Sqlstr = "SELECT * FROM DEV_Item where  ItemChineseName='" & Trim(LrText(1).Text) & "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            With CzxsGrid
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
                .Select .Rows - 1, Qslz
                Call Jltcwg(Cxnrrec, .Rows - 1)
            End With
            Cxnrrec.Close
   
            Tsxx = "保存完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            Call Cshlrxx(1)
            LrText(0).SetFocus
            '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        Else
            If .State = 1 Then .Close
            .Open "SELECT * FROM DEV_Item WHERE " _
                & "ItemChineseName= '" & Trim(LrText(1).Text) & "' " _
                & "and ItemCode<>" & Trim(LrText(0).Text) _
                , Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic

            RecDigest.Close
    
            If P_RecordCount > 0 Then
                Tsxx = "项目重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If
            Cw_DataEnvi.DataConnect.Execute "update DEV_Item set ItemChineseName='" _
                    & Trim(LrText(1).Text) & "',YNcode='" & A_YNStop.Value & "'," _
                    & "ItemFieldType='" & Com_Sort.ListIndex & "',ItmeFieldLength=" _
                    & Val(LrText(2).Text) & ",ItmeCorrelation='" & Trim(LrText(3).Text) & "' " _
                    & ",helpType='" & Combo_X.ListIndex & "',YNJudge='" & Val(YN_Judge.Value) & "',TableName='" & H_str & "' Where ItemCode = " & Trim(LrText(0).Text)
                    
            Sqlstr = "SELECT * FROM DEV_Item  where  ItemCode='" & Trim(LrText(0).Text) & "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Not Cxnrrec.EOF Then
                With CzxsGrid
                    Call Jltcwg(Cxnrrec, .Row)
                End With
            End If
            Cxnrrec.Close
        End If
        Bclrsj = True
        Exit Function
    End With
 
Err_bc:
   
    Tsxx = "存盘过程中出现错误,请退出后重新进入!"
    If Err.Number = -2147217873 Then
        Tsxx = "编码不能重复"
    End If
     
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

End Function

Private Sub Cshlrxx(lrztxx As Integer)              '初始化录入字段信息
 
    If lrztxx = 1 Then
        For jsqte = 0 To Max_Text_Index
            If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
                TextChangeLock = True
                LrText(jsqte).Text = ""
                LrText(jsqte).Tag = ""
                TextChangeLock = False
            End If
            TextValiJudgeLock(jsqte) = True
        Next jsqte
    Else
        With CzxsGrid
            LrText(0).Text = Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)))
            LrText(1).Text = Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls)))
            Com_Sort.ListIndex = Mid(Trim(.TextMatrix(.Row, Sydz("003", GridStr(), Szzls))), 1, 1)
            If Trim(.TextMatrix(.Row, Sydz("003", GridStr(), Szzls))) = 2 Then
                LrText(2).Locked = True
            End If
            LrText(2).Text = Trim(.TextMatrix(.Row, Sydz("004", GridStr(), Szzls)))
            LrText(3).Text = Trim(.TextMatrix(.Row, Sydz("005", GridStr(), Szzls)))
            Combo_X.ListIndex = Mid(Trim(.TextMatrix(.Row, Sydz("006", GridStr(), Szzls))), 1, 1)
            A_YNStop.Value = Val(Trim(.TextMatrix(.Row, Sydz("007", GridStr(), Szzls))))
            YN_Judge.Value = Val((.TextMatrix(.Row, Sydz("008", GridStr(), Szzls))))
        End With
    End If
End Sub

Private Sub Scdqjl()                 '删 除 当 前 记 录
    Dim Yhanswer As Integer

    If Not Security_Log("Dev_ItemSetEdit", Xtczybm, 1, True) Then
        Exit Sub
    End If
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
    Tsxx = "请确认是否删除当前记录?"
    Yhanswer = Xtxxts(Tsxx, 2, 2)
    If Yhanswer = 2 Then
        Exit Sub
    End If
    'On Error GoTo Cwcl
  
    '[以下需自定义部分
  
    Dim aDo_Item As New Recordset
    Set aDo_Item = Cw_DataEnvi.DataConnect.Execute("select * from DEV_Item where ItemCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'")
    Cw_DataEnvi.DataConnect.Execute "ALTER TABLE DEV_RootInfo DROP COLUMN " + aDo_Item!ItemFieldName
    aDo_Item.Close
    Set aDo_Item = Nothing
  
    Cw_DataEnvi.DataConnect.Execute "delete DEV_Item where ItemCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)) & "'")
    '以上为自定义部分]
  
    '<<<<<<<<<<<<<<<<<<<<<<
    CzxsGrid.RemoveItem CzxsGrid.Row
    Exit Sub
Cwcl:
    If Err.Number = -2147217900 Then
        Tsxx = "该编码已经被使用,不能删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    Else
        Tsxx = "出现未知情况,该编码不能被删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
End Sub

'******************以下为基本处理程序(固定不变)************************'

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
    
    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
            Case "P"                   'Ctrl+P 打印
                Call bbyl(False)
            Case "I"                   'Ctrl+I 增加
                If Not Security_Log("Dev_ItemSetEdit", Xtczybm, 1, True) Then
                    Exit Sub
                End If
                Call Toolbjzt
                Lrzt = 1
                Call Cshlrxx(Lrzt)
                LrText(0).SetFocus
                LrText(0).Locked = False
            Case "D"                   'Ctrl+D 删除
                Call Scdqjl
        End Select
    End If

End Sub

Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    For jsqte = 0 To Max_Text_Index
        TextValiJudgeLock(jsqte) = True
    Next jsqte
    Call Toolfbjzt

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("Dev_ItemSetEdit", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Call Toolbjzt
            Lrzt = 1
            Call Cshlrxx(Lrzt)
            LrText(0).Enabled = True
            LrText(0).SetFocus
        Case "xg"                                            '修 改
            If CzxsGrid.Row < CzxsGrid.FixedRows Then MsgBox "没有选定明细！ ", 32: Exit Sub
            Call Xgdqjl
        Case "sc"                                            '删 除
            If Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("007", GridStr(), Szzls))) = True Then
                MsgBox "此项为固定项不能删除！ ", 32
                Exit Sub
            End If
            Call Scdqjl
        Case "fq"                                            '取 消
            Call Toolfbjzt
        Case "sx"                                            '刷 新
            Call Cxnrtcwg