企业管理

开发平台：
Visual Basic

+ަ：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form MS_ItemInfo 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增"
   ClientHeight    =   6420
   ClientLeft      =   1035
   ClientTop       =   1155
   ClientWidth     =   9960
   HelpContextID   =   1301
   Icon            =   "设备台帐.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6420
   ScaleWidth      =   9960
   Begin VB.TextBox Label1 
      BackColor       =   &H80000004&
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      Height          =   225
      Left            =   4080
      TabIndex        =   11
      Text            =   "设备类别:"
      Top             =   750
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Height          =   285
      Left            =   6780
      Picture         =   "设备台帐.frx":1042
      Style           =   1  'Graphical
      TabIndex        =   10
      Top             =   720
      Width           =   345
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   5070
      Locked          =   -1  'True
      TabIndex        =   9
      Top             =   720
      Width           =   1695
   End
   Begin TabDlg.SSTab SSTab1 
      Height          =   5640
      Left            =   60
      TabIndex        =   1
      Top             =   720
      Width           =   9840
      _ExtentX        =   17357
      _ExtentY        =   9948
      _Version        =   393216
      Style           =   1
      Tabs            =   1
      TabsPerRow      =   4
      TabHeight       =   520
      MouseIcon       =   "设备台帐.frx":13CC
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      TabCaption(0)   =   "基本信息&A"
      TabPicture(0)   =   "设备台帐.frx":13E8
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Picture1"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).ControlCount=   1
      Begin VB.PictureBox Picture1 
         Height          =   5023
         Left            =   181
         ScaleHeight     =   4965
         ScaleWidth      =   9465
         TabIndex        =   2
         Top             =   452
         Width           =   9524
         Begin VB.VScrollBar VS_E 
            Height          =   4965
            LargeChange     =   20
            Left            =   9163
            SmallChange     =   200
            TabIndex        =   6
            Top             =   0
            Width           =   286
         End
         Begin VB.PictureBox Pict 
            BackColor       =   &H00E9F2F3&
            BorderStyle     =   0  'None
            Height          =   9042
            Left            =   0
            ScaleHeight     =   9045
            ScaleMode       =   0  'User
            ScaleWidth      =   9150
            TabIndex        =   3
            Top             =   0
            Width           =   9148
            Begin VB.CommandButton Comm_Info 
               Height          =   300
               Left            =   3690
               Picture         =   "设备台帐.frx":1404
               Style           =   1  'Graphical
               TabIndex        =   8
               Top             =   1080
               UseMaskColor    =   -1  'True
               Visible         =   0   'False
               Width           =   300
            End
            Begin VB.CommandButton Comm_Help 
               Height          =   300
               Index           =   0
               Left            =   2528
               Picture         =   "设备台帐.frx":178E
               Style           =   1  'Graphical
               TabIndex        =   7
               Top             =   769
               Visible         =   0   'False
               Width           =   300
            End
            Begin VB.TextBox Text_t 
               BackColor       =   &H00FFFFFF&
               BeginProperty DataFormat 
                  Type            =   0
                  Format          =   "tt hh:mm:ss"
                  HaveTrueFalseNull=   0
                  FirstDayOfWeek  =   0
                  FirstWeekOfYear =   0
                  LCID            =   2052
                  SubFormatType   =   0
               EndProperty
               ForeColor       =   &H00000000&
               Height          =   300
               Index           =   0
               Left            =   858
               TabIndex        =   0
               Top             =   769
               Visible         =   0   'False
               Width           =   1474
            End
            Begin VB.Label T_Label 
               AutoSize        =   -1  'True
               BackColor       =   &H00E9F2F3&
               BackStyle       =   0  'Transparent
               Caption         =   "编号"
               Height          =   180
               Index           =   0
               Left            =   405
               TabIndex        =   4
               Top             =   810
               Visible         =   0   'False
               Width           =   360
            End
         End
      End
   End
   Begin MSComctlLib.Toolbar SzToolbar 
      Align           =   1  'Align Top
      Height          =   570
      Left            =   0
      TabIndex        =   5
      Top             =   0
      Width           =   9960
      _ExtentX        =   17568
      _ExtentY        =   1005
      ButtonWidth     =   820
      ButtonHeight    =   953
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   14
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "设置"
            Key             =   "ymsz"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "打印"
            Key             =   "dy"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "预览"
            Key             =   "yl"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "保存"
            Key             =   "Save"
            ImageIndex      =   13
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Enabled         =   0   'False
            Caption         =   "删除"
            Key             =   "Del"
            ImageIndex      =   6
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "下个"
            Key             =   "Below"
            ImageIndex      =   14
            Style           =   3
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Enabled         =   0   'False
            Caption         =   "刷新"
            Key             =   "sx"
            ImageIndex      =   7
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.Visible         =   0   'False
            Caption         =   "编辑"
            Key             =   "Text"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "放弃"
            Key             =   "fq"
            ImageIndex      =   15
         EndProperty
         BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "bz"
            ImageIndex      =   8
         EndProperty
         BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "Exit"
            ImageIndex      =   9
         EndProperty
      EndProperty
      BorderStyle     =   1
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   5760
         Top             =   0
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   16
         ImageHeight     =   16
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   15
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":1B18
               Key             =   "sz"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":1EB2
               Key             =   "dy"
            EndProperty
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":224C
               Key             =   "yl"
            EndProperty
            BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":25E6
               Key             =   "xz"
            EndProperty
            BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":2980
               Key             =   "xg"
            EndProperty
            BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":2D1A
               Key             =   "sc"
            EndProperty
            BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":30B4
               Key             =   "sx"
            EndProperty
            BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":344E
               Key             =   "bz"
            EndProperty
            BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":37E8
               Key             =   "tc"
            EndProperty
            BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":3B82
               Key             =   "bcgs"
            EndProperty
            BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":3F1C
               Key             =   "mrlk"
            EndProperty
            BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":42B6
               Key             =   "xsxm"
            EndProperty
            BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":4650
               Key             =   "bc"
            EndProperty
            BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":49EA
               Key             =   "xyg"
            EndProperty
            BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "设备台帐.frx":4D84
               Key             =   "fq"
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "MS_ItemInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim tf As Boolean
Dim VS_int As Integer     ' 上一次滚动的值
Dim RecoRows_int As Integer
Dim Ssql_str As String
Dim add_item As New ADODB.Recordset
Dim VsE_TF As Boolean      '滚动条是否有效
Dim H_MoveInt As Integer   '当前鼠标所处的位置
Dim Com_ListIndexTF As Boolean
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim Text_YNcode(): Dim Com_YNcode(): Dim Text_YNRoot(): Dim Error_TF As Boolean
'<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim FileName As String
'<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim Employee_ID As Integer  'ID:
Dim Save_TF As Boolean '检测是否成功
Private Sub Comm_Help_Click(Index As Integer)    '基本信息输入调用帮助
    If Mid(Text_T(Help_Str(Comm_Help(Index).Tag, True)).Tag, 1, 1) = 2 Then
       XT_calendar.Show 1
       If Xtfhcs <> "" Then
       Text_T(Help_Str(Comm_Help(Index).Tag, True)).Text = Xtfhcs
       Xtfhcs = ""
       End If
       Text_T(Help_Str(Comm_Help(Index).Tag, True)).SetFocus
       Exit Sub
    End If
    '---------------------
    YesNo_str = Text_T(Help_Str(Comm_Help(Index).Tag, True)).Text
    SsqlHelp = Help_Str(Comm_Help(Index).Tag, False)
    E_HelpItem.Show 1
    '---------------------
    If P_Name <> "" Then
       Text_T(Help_Str(Comm_Help(Index).Tag, True)).Text = P_Name
       Text_YNcode(2, Help_Str(Comm_Help(Index).Tag, True)) = P_Code
       P_Name = ""
       P_Code = ""
    End If
    '---------------------
    Text_T(Help_Str(Comm_Help(Index).Tag, True)).SetFocus
End Sub
Private Sub Comm_Help_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    H_MoveInt = Index
End Sub
Private Sub Comm_Info_Click()
    SsqlHelp = "记录信息"
    YesNo_str = Text_T(1).Text
    E_HelpItem.Show 1
    '---------------------
    If Trim(P_Code) <> "" Then
       Text_T(1).Text = P_Code
       Dim i As Integer
       For i = 2 To Text_T.count - 1
          Text_T(i).Text = ""
       Next i
       Text_T_KeyDown 1, 13, 0
    End If
End Sub
Private Sub Command1_Click()
    MS_ItemDEVSort.Show 1
    If Trim(MS_ItemDEVSort.Combo1.Tag) <> "" Then
    '------------
        Comm_Info.Visible = False
        Command1.Tag = MS_ItemDEVSort.Combo1.ItemData(MS_ItemDEVSort.Combo1.ListIndex)
        Text1.Text = MS_ItemDEVSort.Combo1.Text
        '------------------
        Employee_ID = 0: Error_TF = True
        Refurbish
        List
    '------------------
    End If
End Sub
Public Sub Form_Load()
    Employee_ID = 0: Error_TF = True
    Refurbish
    List
End Sub
Public Sub List()          '显示项目
    '--------------
    VsE_TF = False
    Pict.Top = 0: Pict.Left = 0: VS_E.Value = 0
    VsE_TF = True
    '----------------
    '卸载界面控件
    Dim B As Integer
    For B = 1 To Text_T.count - 1
       Unload Text_T(B): Unload T_Label(B)
    Next B
    For B = 1 To Comm_Help.count - 1
       Unload Comm_Help(B)
    Next B
    '<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Dim i As Integer:  Dim c As Integer
    i = 1: c = 1
    If Trim(Command1.Tag) = "" Then Exit Sub
    VS_E.Max = 500: VS_int = 0
    Set add_item = Cw_DataEnvi.DataConnect.Execute("select * from DEV_Itemlist where ISID=" & Val(Command1.Tag) & "and YNShow='1' order by tab")
        RecoRows_int = add_item.RecordCount
        Do While Not add_item.EOF
        '---------------------------
          If add_item!HelpType = "0" Or Trim(add_item!ItmeCorrelation) = "" Then                    'add_item!ItemFieldType <> "2" And
           '创建文本框
                Load T_Label(i): Load Text_T(i)
                T_Label(i).Left = Val(add_item!itemleft & "")
                T_Label(i).Top = Val(add_item!itemtop & "")
                T_Label(i).Tag = add_item!ItemFieldName & Val("" & add_item!YNJudge)
                T_Label(i).Caption = add_item!ItemChineseName
                ReDim Preserve Text_YNcode(2, i + 1)
                Text_YNcode(1, i) = add_item!yncode
                ReDim Preserve Text_YNRoot(i + 1)
                Text_YNRoot(i) = add_item!YNRoot
                '------------------------
                Text_T(i).Left = T_Label(i).Left + T_Label(i).Width + 100
                Text_T(i).Top = T_Label(i).Top - 50
                Text_T(i).TabIndex = "" & add_item!Tab - 1
                Text_T(i).Tag = add_item!ItemFieldType
                Text_T(i).Width = add_item!ItmeFieldLength * 105
                Text_T(i).MaxLength = add_item!ItmeFieldLength
                '----------- 修改时
                If AddExit_TF = False Then Text_T(i).Enabled = False
                If AddExit_TF = False And add_item!ItemChineseName = "设备编号" Then
                    Comm_Info.Top = Text_T(i).Top
                    Comm_Info.Left = Text_T(i).Width + Text_T(i).Left
                    Comm_Info.Visible = True
                    Text_T(i).Enabled = True
                End If
                '------------
                If Trim(add_item!ItmeCorrelation) <> "" Or add_item!ItemFieldType = 2 Then
                   '创建帮助按键
                    Load Comm_Help(c)
                    Comm_Help(c).Left = Text_T(i).Left + Text_T(i).Width
                    Comm_Help(c).Top = Text_T(i).Top
                    Comm_Help(c).Tag = i & "." & add_item!ItemCode
                    Comm_Help(c).Visible = True
                    '----------- 修改时
                    If AddExit_TF = False Then Comm_Help(c).Enabled = False
                    '-----------
                    Text_T(i).Tag = Text_T(i).Tag & "." & c
                    c = c + 1
                End If
                '--------------
                Text_T(i).Visible = True
                T_Label(i).Visible = True
                i = i + 1
           End If
           '<<<<<<<<<<<<<<<<<<<<<
           '<<<<<<<<<<<<<<<<<<<<<
           If Trim("" & add_item!ItmeCorrelation) <> "" _
              And add_item!HelpType = 1 Then
              '创建下拉列表框
              MsgBox "创建下拉列表框！ ", 48
            End If
            '------------
            add_item.MoveNext
        Loop
        add_item.Close
End Sub
Private Sub Pict_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    H_MoveInt = 0
End Sub
Private Sub Text_T_GotFocus(Index As Integer)
    Pi_mvoe Text_T(Index)
End Sub
Public Sub Text_T_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
 '焦点移动
    If KeyCode = 113 And Help_Str(Text_T(Index).Tag, False) <> 0 Then
        H_MoveInt = Help_Str(Text_T(Index).Tag, False)
        Comm_Help_Click (Help_Str(Text_T(Index).Tag, False))
    End If
    H_MoveInt = 0
    '-----------
    If KeyCode = 13 Then
        If AddExit_TF = False And Mid(T_Label(Index).Tag, 1, Len(T_Label(Index).Tag) - 1) = "Dcode" And Comm_Info.Enabled = True Then
            If Fun_IfSearch() Then
                Edit_Refurbish Text_T(Index).Text, Index, False
                Exit Sub
            End If
        End If
        SendKeys "{Tab}", True
    End If
End Sub
'*****Added by qiaojin at 2001-5-16**************
Private Function Fun_IfSearch() As Boolean
    Dim i As Integer
    Fun_IfSearch = True
    For i = 2 To Me.Text_T.count - 1
        If Len(Text_T(i)) <> 0 Then
            Fun_IfSearch = False
            Exit Function
         End If
    Next i
    
End Function
'**********************************************
Private Sub Text_T_KeyPress(Index As Integer, KeyAscii As Integer)
    '判断输入的有效性
    If KeyAscii = 39 Then KeyAscii = 0
    Select Case Mid(Text_T(Index).Tag, 1, 1)
           Case 2
               Call InputFieldLimit(Text_T(Index), 7, KeyAscii)
           Case 1
               Call InputFieldLimit(Text_T(Index), 6, KeyAscii)
    End Select
End Sub
Private Sub Text_T_LostFocus(Index As Integer)       '有效判断
'-------------------
If Help_Str(Text_T(Index).Tag, False) <> H_MoveInt Then
    If Mid(Text_T(Index).Tag, 1, 1) = 2 And Trim(Text_T(Index).Text) <> "" Then
        '-------------------
        If IsDate(Text_T(Index)) = False Then
            MsgBox "非法日期格式！" & Format(Date, "yyyy-mm-dd"), 16
            Text_T(Index).SetFocus
            Error_TF = False
            Exit Sub
        Else
            '-----------
            If Text_T(Index).Text > "1950-01-01" And Text_T(Index).Text < "2100-01-01" Then
                Text_T(Index).Text = Format(Trim(Text_T(Index).Text), "yyyy-mm-dd")
            Else
                MsgBox "非法日期格式！" & Format(Date, "yyyy-mm-dd"), 16
                Text_T(Index).SetFocus
                Error_TF = False
                Exit Sub
            End If
            '-----------
        End If
        '-------------------
    End If
    '----------------------
    If Mid(T_Label(Index).Tag, Len(T_Label(Index).Tag), Len(T_Label(Index).Tag)) = 1 Then
        '------------------- 是否要有效性判断
        If Mid(Text_T(Index).Tag, 1, 1) <> 2 And _
           Help_Str(Text_T(Index).Tag, False) <> "0" _
           And Trim(Text_T(Index).Text) <> "" Then
           '----------------
            If Rows_int(Help_Str(Comm_Help(Help_Str(Text_T(Index).Tag, False)).Tag, False), Trim(Text_T(Index).Text)) > 0 Then
                Text_T(Index).Text = Trim(P_Name)
                Text_YNcode(2, Index) = Trim(P_Code)
            Else
                MsgBox "非法录入,没有此" & T_Label(Index).Caption, 48, "建档"
                Error_TF = False
                Text_T(Index).SetFocus
            End If
            '------------------
        End If
     End If
     '---------------------
 End If
 
End Sub
Private Sub VS_E_Change()     '滚动条
    If VsE_TF = True Then
        If VS_int < VS_E.Value Then
            Pict.Top = Pict.Top - (VS_E.Value * 8 - VS_int)
        Else
            If VS_int <> VS_E.Value Then
              Pict.Top = Pict.Top + (VS_int - VS_E.Value * 8)
            End If
        End If
        VS_int = VS_E.Value * 8
    End If
End Sub
Private Sub Pi_mvoe(ob As Object)   '屏幕滚动
    If ob.Top > 5000 + VS_E.Value * 8 Then     '向下滚动
       VS_E.Value = (ob.Top - 4580)  8
    End If
    '------------------------------
    If 5000 + VS_E.Value - ob.Top > 5000 Then  '向上滚动
       If ob.Top < 5000 Then
          VS_E.Value = 0
         Else
          VS_E.Value = (ob.Top - 4580)  8
       End If
    End If
End Sub
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
       Case "yl"
          '  Class_Rs.Print_EnployeeInfo
       Case "Save"
            If AddExit_TF = False Then
               YesNo_str = MsgBox("你是否要保存此记录的修改？ ", 32 + vbYesNo, "档案修改:")
               If YesNo_str = vbNo Then Exit Sub
               Else
               YesNo_str = MsgBox("你是否要保存此记录？ ", 32 + vbYesNo, "建档:")
               If YesNo_str = vbNo Then Exit Sub
            End If
            YesNo_Judge
       Case "Below"
            YesNo_str = MsgBox("当前数据是否要保存？ ", 32 + vbYesNo, "建档:")
            If YesNo_str = vbNo Then
                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

						