VB开发的ERP系统

End Function

Private Sub Scdqjl()                 '删 除 当 前 记 录
    
    Dim yhAnswer As Integer
    Dim aDo_Rec As New Recordset

    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    '系统预置记录不能被删除
    Set rstemp = New ADODB.Recordset
    rstemp.Open "SELECT * FROM Gdzc_VariationMode Where FAVariCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "' and EditFlag='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        Tsxx = "您没有权限删除该记录!"
        Call Xtxxts(Tsxx, 0, 4)
        Call Cancel
        Exit Sub
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    '已引用记录不能被删除
    Set rstemp = New ADODB.Recordset
    rstemp.Open "SELECT FAVariCode FROM Gdzc_Variation Where FAVariCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        Tsxx = "此记录已被引用，不能删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Call Cancel
        Exit Sub
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    '非数据行不能删除
    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
  
    Cw_DataEnvi.DataConnect.BeginTrans
 
    '[>>以下需自定义部分
    Cw_DataEnvi.DataConnect.Execute "delete Gdzc_VariationMode where FAVariCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "' and EditFlag='1'"
  
    Add_Tree
    '以上为自定义部分<<]
  
    Cw_DataEnvi.DataConnect.CommitTrans
  
    '将记录加入网格
    Call Cxnrtcwg

    Exit Sub
  
Cwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    If Err.Number = -2147217873 Then                '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
        Tsxx = "该编码已经被使用,不能删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    Else
        Tsxx = "出现未知情况,该编码不能被删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If

End Sub

'*******************以下区域为编写自定义过程区域**********************
Private Sub Com_VariMode_GotFocus()
    
    If Lrzt = 1 Then
        If Trim(Com_VariMode.Text) = "增加" Then
            LrText(0).Text = "001"
        Else
            LrText(0).Text = "002"
        End If
    End If

End Sub

Private Sub Com_VariMode_Click()
    
    If Lrzt = 1 Then
        If Trim(Com_VariMode.Text) = "增加" Then
            LrText(0).Text = "001"
        Else
            LrText(0).Text = "002"
        End If
    End If

End Sub

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

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

Private Sub Add_Tree() '添加树项
    
    Dim aDo_Sort As New Recordset
    TreeView.Nodes.Clear
    TreeView.Nodes.Add , 4, "T", "变动方式", "T"
    TreeView.Nodes.Add "T", 4, "X", "增加", "Cl"
    TreeView.Nodes.Add "T", 4, "Y", "减少", "Cl"
    TreeView.Nodes.Add "T", 4, "M", "部分增减", "Cl"
    TreeView.Nodes.Add "T", 4, "Z", "其它变动", "Cl"
    Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select * from Gdzc_VariationMode order by FAVariCode")
    With aDo_Sort
        Do While Not .EOF
            If aDo_Sort!VariSort = 1 Then
                Set nodX = TreeView.Nodes.Add("X", 4, "X" & Trim(.Fields("FAVariCode")), "(" & Trim(.Fields("FAVariCode")) & ")" & Trim(.Fields("FAVariName")), "C")
            ElseIf aDo_Sort!VariSort = 2 Then
                Set nodX = TreeView.Nodes.Add("Y", 4, "Y" & Trim(.Fields("FAVariCode")), "(" & Trim(.Fields("FAVariCode")) & ")" & Trim(.Fields("FAVariName")), "C")
            ElseIf aDo_Sort!VariSort = 3 Then
                Set nodX = TreeView.Nodes.Add("M", 4, "M" & Trim(.Fields("FAVariCode")), "(" & Trim(.Fields("FAVariCode")) & ")" & Trim(.Fields("FAVariName")), "C")
            ElseIf aDo_Sort!VariSort = 4 Then
                Set nodX = TreeView.Nodes.Add("Z", 4, "Z" & Trim(.Fields("FAVariCode")), "(" & Trim(.Fields("FAVariCode")) & ")" & Trim(.Fields("FAVariName")), "C")
            End If
            nodX.EnsureVisible
            .MoveNext
        Loop
    End With
    aDo_Sort.Close
    Set aDo_Sort = Nothing
End Sub
 
'编码方案
Private Sub Text_CodScheme()
    
    Dim aDo_Sort As New Recordset
    Dim i As Integer, h As Integer
    Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute("select * from Gy_CodeScheme where ItemCode='" & Trim(CodSchemeIndex) & "'")
    CodScheme = Trim(aDo_Sort!CodeScheme)
    aDo_Sort.Close
    '-------------
    StTab.Tab = 1
    Lbl_codescheme.Caption = ""
    For i = 1 To Len(CodScheme)
        For h = 1 To Val(Mid(CodScheme, i, 1))
            Lbl_codescheme = Lbl_codescheme & "*"
        Next
        Lbl_codescheme = Lbl_codescheme & " "
    Next i
    Lbl_codescheme = Trim(Lbl_codescheme)

End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True

End Sub

Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    Dim sglPos As Single
    If mbMoving Then
        sglPos = x + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If

End Sub

Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False

End Sub

Private Sub SizeControls(x As Single)
    
    On Error Resume Next

    '设置 Width 属性
    If x < 2000 Then x = 2000
    If x > (Me.Width - 5000) Then x = Me.Width - 5000
    TreeView.Width = x - 100
    imgSplitter.Left = x
    StTab.Left = x + 40
    StTab.Width = Me.Width - (TreeView.Width + 300)
    '设置 Top 属性
    TreeView.Top = tbToolBar.Height + picTitles.Height
    StTab.Top = TreeView.Top
    '设置 height 属性
    TreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
    'Frame1.Width = StTab.Width - Frame1.Left * 2
    Dim St_tab As Integer
    St_tab = StTab.Tab
    StTab.Tab = 0
    CzxsGrid.Width = StTab.Width - CzxsGrid.Left * 2
    StTab.Tab = St_tab
    StTab.Height = TreeView.Height
    imgSplitter.Top = TreeView.Top
    imgSplitter.Height = TreeView.Height

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 打印
                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)
            If CzxsGrid.Row > 0 Then
                LrText(0) = Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)))
            End If
            LrText(0).Text = "001"
            LrText(0).SetFocus
            Com_VariMode.Enabled = True
            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) Then
        Exit Sub
    End If
    
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
    Call Toolbjzt
    Lrzt = 2
    If Cshlrxx(Lrzt) Then
        Com_VariMode.Enabled = False
        LrText(1).SetFocus
        LrText(0).Locked = True
    End If

End Sub

Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
    
    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    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
    TreeView.Enabled = False

End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
    
    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    CzxsGrid.Enabled = True
    StTab.TabEnabled(1) = False
    Lrzt = 0
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True