设备台帐.frm

新世纪ERP设备管理源代码

                Save_TF = True
            Else
                YesNo_Judge
            End If
            '-----------
            If Save_TF = True Then
                Employee_ID = 0
                Refurbish
            End If
            Save_TF = False
       Case "sx"
            Refurbish
            Edit_Refurbish "sx", 1, True
       Case "Text"
            AddExit_TF = False
            '---------------------
            Employee_ID = 0: Error_TF = True
            Refurbish
            List
            '--------------------
            SzToolbar.Buttons(10).Enabled = False
            SzToolbar.Buttons(11).Enabled = True
            Me.Caption = "修改"
            Text_T(0).Locked = True
       Case "fq"
            Save_TF = True
            If Save_TF = True Then
                Employee_ID = 0
                Refurbish
            End If
            Save_TF = False
       Case "bz"
            Call F1bz
       Case "Del"
            YesNo_str = MsgBox("你是否真的要删除此档案？ ", 32 + vbYesNo, "建档:")
            If YesNo_str = vbNo Then Exit Sub
            On Error GoTo Err_Del
                Cw_DataEnvi.DataConnect.BeginTrans
                '<<<<<<<<<<<<<<<<<<<<< '自定义
                Cw_DataEnvi.DataConnect.Execute "DELETE DEV_RootInfo WHERE ID=" & Employee_ID
                Cw_DataEnvi.DataConnect.Execute "DELETE DEV_main WHERE ID=" & Employee_ID
                '<<<<<<<<<<<<<<<<<<<<<
                Cw_DataEnvi.DataConnect.CommitTrans
                Employee_ID = 0
                Refurbish
                Exit Sub
Err_Del:
                Cw_DataEnvi.DataConnect.RollbackTrans
                MsgBox "删除失败！  ", 16
                
       Case "Exit"
            Unload Me
End Select

End Sub
Private Sub YesNo_Judge()  '有效性判定
    Dim i As Integer
    '文本框有效性判定
    For i = 1 To Text_T.count - 1
        If Mid(T_Label(i).Tag, Len(T_Label(i).Tag), Len(T_Label(i).Tag)) = 1 Then
            If Text_T(i).Text = "" Then
               MsgBox T_Label(i).Caption & "不能为空！ ", 48, "建档:"
               Text_T(i).SetFocus: Exit Sub
            End If
               Text_T_LostFocus i
               If Error_TF = False Then Text_T(i).SetFocus: Error_TF = True: Exit Sub
        End If
    Next i
    Save_EmployeeIndo
End Sub
Private Sub Save_EmployeeIndo() '保存
Dim i As Integer: Dim EmployeeNu As String '职工号
Dim Ssql1 As String: Dim Ssql2 As String: Dim Ssql3 As String: Dim Ssql4 As String
Dim aDo_Eid As New Recordset: Dim MAXID_Z As Integer

    If T_Label.count < 2 Then MsgBox "没有项目！ ", 16: Exit Sub

    For i = 1 To T_Label.count - 1
        If Text_YNRoot(i) = 1 Then
            With T_Label(i)
                '------------------
                If Employee_ID = 0 Then
                    Ssql3 = Ssql3 & Mid(.Tag, 1, Len(.Tag) - 1) & ","
                    If Text_YNcode(1, i) = 1 Then
                        Ssql4 = Ssql4 & "'" & Text_YNcode(2, i) & "',"
                    Else
                        Ssql4 = Ssql4 & "'" & Trim(Text_T(i).Text) & "',"
                    End If
                Else
                    If Text_YNcode(1, i) = 1 Then
                        Ssql3 = Ssql3 & Mid(.Tag, 1, Len(.Tag) - 1) & "='" & Text_YNcode(2, i) & "',"
                    Else
                        Ssql3 = Ssql3 & Mid(.Tag, 1, Len(.Tag) - 1) & "='" & Trim(Text_T(i).Text) & "',"
                    End If
                End If
                '------------------
                If Mid(.Tag, 1, Len(.Tag) - 1) = "Dcode" Then EmployeeNu = Trim(Text_T(i).Text)
            End With
        End If
    Next i
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    For i = 1 To T_Label.count - 1
        If Text_YNRoot(i) <> 1 Then
            With T_Label(i)
                '------------------
                If Employee_ID = 0 Then
                    Ssql1 = Ssql1 & Mid(.Tag, 1, Len(.Tag) - 1) & ","
                    If Text_YNcode(1, i) = 1 Then
                        Ssql2 = Ssql2 & "'" & Text_YNcode(2, i) & "',"
                    Else
                        Ssql2 = Ssql2 & "'" & Trim(Text_T(i).Text) & "',"
                    End If
                Else
                    If Text_YNcode(1, i) = 1 Then
                        Ssql1 = Ssql1 & Mid(.Tag, 1, Len(.Tag) - 1) & "='" & Text_YNcode(2, i) & "',"
                    Else
                        Ssql1 = Ssql1 & Mid(.Tag, 1, Len(.Tag) - 1) & "='" & Trim(Text_T(i).Text) & "',"
                    End If
                End If
                '------------------
            End With
        End If
    Next i

On Error GoTo Quit_Err

    If Employee_ID = 0 Then
       Set aDo_Eid = Cw_DataEnvi.DataConnect.Execute("select * from DEV_MAIN where DCODE='" & EmployeeNu & "'")
    Else
       Set aDo_Eid = Cw_DataEnvi.DataConnect.Execute("select * from DEV_MAIN where DCODE='" & EmployeeNu & "' and ID<>" & Employee_ID)
    End If
    If aDo_Eid.RecordCount > 0 Then MsgBox "设备编号重复！  ", 48, "建档:": aDo_Eid.Close: Exit Sub
    aDo_Eid.Close
    '-----------------------------
    If Employee_ID = 0 Then
        '新增记录
        Set aDo_Eid = Cw_DataEnvi.DataConnect.Execute("select MAXID=MAX(ID) from DEV_MAIN")
        MAXID_Z = Val("" & aDo_Eid!MAXID) + 1
        If Trim(Ssql1) <> "" Then
            Ssql1 = "insert into DEV_RootInfo( ID," & Mid(Ssql1, 1, Len(Ssql1) - 1) & ") values( " & Val("" & aDo_Eid!MAXID) + 1 & "," & Mid(Ssql2, 1, Len(Ssql2) - 1) & ")"
        Else
            Ssql1 = "insert into DEV_RootInfo( ID) values( " & Val("" & aDo_Eid!MAXID) + 1 & ")"
        End If
        Ssql3 = "insert into DEV_main( ID,Lcode," & Mid(Ssql3, 1, Len(Ssql3) - 1) & ") values( " & Val("" & aDo_Eid!MAXID) + 1 & "," & Val(Command1.Tag) & "," & Mid(Ssql4, 1, Len(Ssql4) - 1) & ")"
        aDo_Eid.Close
        '----------
    Else
        '修改记录
        If Trim(Ssql1) <> "" Then
            Ssql1 = "update DEV_RootInfo SET " & Mid(Ssql1, 1, Len(Ssql1) - 1) & " where ID=" & Employee_ID
        End If
        Ssql3 = "update DEV_main SET " & Mid(Ssql3, 1, Len(Ssql3) - 1) & " where ID=" & Employee_ID
    End If
    
    Cw_DataEnvi.DataConnect.Execute Ssql3
    If Trim(Ssql1) <> "" Then Cw_DataEnvi.DataConnect.Execute Ssql1
    MsgBox "保存成功！   ", 48, "档案:"
    Refurbish
    Save_TF = True
Exit Sub

Quit_Err:
Save_TF = False
MsgBox "保存失败！   ", 16, "档案:"

End Sub

Private Sub Edit_Refurbish(EN As String, Index As Integer, Refu_TF As Boolean)
On Error Resume Next
Dim aDo_Info As New Recordset: Dim aDo_F As New Recordset
Dim i As Integer: Dim SSql As String
If Refu_TF = False Then
    Employee_ID = 0
    SSql = Item_Info & " where b.Dcode='" & EN & "' and b.id=a.id"
    aDo_Info.Open SSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
    If aDo_Info.RecordCount < 1 Then MsgBox "无效设备位号！  ", 48, "档案修改:": aDo_Info.Close: Text_T(Index).SetFocus: Exit Sub
Else
    SSql = Item_Info & " where b.id=" & Employee_ID & " and b.id=a.id"
    aDo_Info.Open SSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
End If

If Not aDo_Info.EOF Then
'-----------
    Command1.Tag = aDo_Info!Lcode
    Text1.Text = aDo_Info!N_Lcode
    '------------------
    Employee_ID = 0: Error_TF = True
    Refurbish
    List
    '---------------------
    For i = 1 To T_Label.count - 1
        With T_Label(i)
            If Text_YNcode(1, i) = 1 Then
                Text_T(i).Text = "" & aDo_Info("N_" & Mid(.Tag, 1, Len(.Tag) - 1))
                Text_YNcode(2, i) = "" & aDo_Info(Trim(Mid(.Tag, 1, Len(.Tag) - 1)))
            Else
                Text_T(i).Text = "" & aDo_Info(Mid(.Tag, 1, Len(.Tag) - 1))
            End If
            Text_T(i).Enabled = True
            '---------
            If Mid(.Tag, 1, Len(.Tag) - 1) = "Dcode" Then
                Text_T(i).Enabled = False
                Comm_Info.Enabled = False
            End If
            '---------
        End With
    Next
    Employee_ID = aDo_Info!Id
    '--------------------------
    For i = 1 To Comm_Help.count - 1
       Comm_Help(i).Enabled = True
    Next i
'----------------
End If
aDo_Info.Close
SzToolbar.Buttons(5).Enabled = True: SzToolbar.Buttons(7).Enabled = True
SzToolbar.Buttons(8).Enabled = True: SzToolbar.Buttons(9).Enabled = True

End Sub

Private Sub Refurbish()
On Error Resume Next
    Dim i As Integer
    Me.SetFocus
    If AddExit_TF = False Then
        '修改时界面状态
        Comm_Info.Enabled = True
        SzToolbar.Buttons(5).Enabled = False: SzToolbar.Buttons(7).Enabled = False
        SzToolbar.Buttons(8).Enabled = False: SzToolbar.Buttons(9).Enabled = False
        For i = 1 To Comm_Help.count - 1
           Comm_Help(i).Enabled = False
        Next i
    End If
    '-------------------
    '文本框编辑状态
    For i = 1 To Text_T.count - 1
        Text_T(i).Text = ""
        If AddExit_TF = False Then
            Text_T(i).Enabled = False
        End If
        '定义
        If Mid(T_Label(i).Tag, 1, Len(T_Label(i).Tag) - 1) = "Dcode" Then
            Text_T(i).Enabled = True
            Text_T(i).SetFocus
        End If
    Next i
End Sub

Public Function Help_Str(Str As String, tf As Boolean) As String  '截点前、点后
    Dim i As Integer
    Str = Trim(Str)
    For i = 1 To Len(Str)
        If Mid(Str, i, 1) = "." Then Exit For
    Next i
    If tf = True Then
        Help_Str = Mid(Str, 1, i - 1)
        Else
        If i = Len(Str) + 1 Then
            Help_Str = "0"
        Else
            Help_Str = Mid(Str, i + 1, Len(Str))
        End If
    End If
End Function


Public Function Rows_int(Str As String, StrText As String)   '查找记录的条数
    Dim aDo_Rec As New Recordset
    Dim SSql As String
    '----------------------------
    Dim aDo_Item As New Recordset
    Set aDo_Item = Cw_DataEnvi.DataConnect.Execute("select * from DEV_Item where itemCode=" & Str)
    If Trim(aDo_Item!TableName) = "CorrelationList" Then
        SSql = "select * from DEV_CorrelationSort A,DEV_CorrelationList B where " _
               & "A.SortCode=b.SortCode and A.SortName='" & Trim(aDo_Item!ItmeCorrelation) & "' and listname='" & Trim(StrText) & "'"
    Else
        SSql = "select * from " & aDo_Item!TableName & " where " & aDo_Item!CloumnName2 & "='" & Trim(StrText) & "'"
       
    End If
    '-----------------------------
    Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute(SSql)
    Rows_int = aDo_Rec.RecordCount
    '--------------------------------
    If Rows_int < 1 Then
        If Trim(aDo_Item!TableName) = "CorrelationList" Then
            SSql = "select * from DEV_CorrelationSort A,DEV_CorrelationList B where " _
                & "A.SortCode=b.SortCode and A.SortName='" & Trim(aDo_Item!ItmeCorrelation) & "' and listCode='" & Trim(StrText) & "'"
        Else
            SSql = "select * from " & aDo_Item!TableName & " where " & aDo_Item!CloumnName1 & "='" & Trim(StrText) & "'"
        End If
        Set aDo_Rec = Cw_DataEnvi.DataConnect.Execute(SSql)
        Rows_int = aDo_Rec.RecordCount
    End If
    
    If Rows_int > 0 Then
        If Trim(aDo_Item!TableName) = "CorrelationList" Then
            P_Name = aDo_Rec!Listname
            P_Code = aDo_Rec!ListCode
        Else
            P_Name = Trim(aDo_Rec(Trim(aDo_Item!CloumnName2)))
            P_Code = aDo_Rec(Trim(aDo_Item!CloumnName1))
        End If
    End If
    
    If aDo_Item.State = 1 Then
        aDo_Item.Close
        Set aDo_Item = Nothing
    End If
    
    aDo_Rec.Close

End Function