设备档案_设备台帐.frm

新世纪ERP设备管理源代码

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 '检测是否成功
Dim TF_Save 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)
    Dev_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
    Dev_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()
    Dev_ItemDEVSort.Show 1
    If Trim(Dev_ItemDEVSort.Combo1.Tag) <> "" Then
    '------------
        Comm_Info.Visible = False
        Command1.Tag = Dev_ItemDEVSort.Combo1.ItemData(Dev_ItemDEVSort.Combo1.ListIndex)
        Text1.Text = Dev_ItemDEVSort.Combo1.Text
        '------------------
        Employee_ID = 0: Error_TF = True
        Refurbish
        List
    '------------------
    End If
End Sub



Private Sub Command2_Click(Index As Integer)
    Dim i As Integer
    Select Case Index
        Case 0
            If T_Label.Count < 2 Then
                MsgBox "没有项目! ", vbInformation, "新世纪/ERP5.0-设备管理"
                Exit Sub
            End If
            For i = 1 To T_Label.Count - 1
                If Mid(T_Label(i).Tag, 1, Len(T_Label(i).Tag) - 1) = "DEVID" Then
                    If Text_t(i).Text = "" Then
                        YesNo_str = MsgBox("请先录入设备卡片！ ", 32 + vbYes, "新世纪/ERP5.0-设备管理")
                        If YesNo_str = vbNo Then Exit Sub
                        Exit Sub
                    Else
                        StrTemp = Text_t(i).Text
                        If AddExit_TF = True Then
                            TF_Save = False
                            YesNo_Judge
                            If TF_Save = False Then
                                Exit Sub
                            End If
                        End If
                            Exit For
                            TF_Save = False
                    End If
                End If
            Next i
            Dev_LayOutForm.Show 1
        Case 1
            If T_Label.Count < 2 Then
                MsgBox "没有项目! ", vbInformation, "新世纪/ERP5.0-设备管理"
                Exit Sub
            End If
            For i = 1 To T_Label.Count - 1
                If Mid(T_Label(i).Tag, 1, Len(T_Label(i).Tag) - 1) = "DEVID" Then
                    If Text_t(i).Text = "" Then
                        YesNo_str = MsgBox("请先录入设备卡片！ ", 32 + vbYes, "新世纪/ERP5.0-设备管理")
                        If YesNo_str = vbNo Then Exit Sub
                        Exit Sub
                    Else
                        StrTemp = Text_t(i).Text
                        If AddExit_TF = True Then
                            TF_Save = False
                            YesNo_Judge
                            If TF_Save = False Then
                                Exit Sub
                            End If
                        End If
                            Exit For
                            TF_Save = False
                    End If
                End If
            Next i
            Dev_AmplidyneForm.Show 1
        
        Case 2
            If T_Label.Count < 2 Then
                MsgBox "没有项目! ", vbInformation, "新世纪/ERP5.0-设备管理"
                Exit Sub
            End If
            For i = 1 To T_Label.Count - 1
                If Mid(T_Label(i).Tag, 1, Len(T_Label(i).Tag) - 1) = "DEVID" Then
                    If Text_t(i).Text = "" Then
                        YesNo_str = MsgBox("请先录入设备卡片！ ", 32 + vbYes, "新世纪/ERP5.0-设备管理")
                        If YesNo_str = vbNo Then Exit Sub
                        Exit Sub
                    Else
                        StrTemp = Text_t(i).Text
                        If AddExit_TF = True Then
                            TF_Save = False
                            YesNo_Judge
                            If TF_Save = False Then
                                Exit Sub
                            End If
                        End If
                            Exit For
                            TF_Save = False
                    End If
                End If
            Next i
            Dev_SparePartForm.Show 1
        
        
        Case 3
            If T_Label.Count < 2 Then
                MsgBox "没有项目! ", vbInformation, "新世纪/ERP5.0-设备管理"
                Exit Sub
            End If
            For i = 1 To T_Label.Count - 1
                If Mid(T_Label(i).Tag, 1, Len(T_Label(i).Tag) - 1) = "DEVID" Then
                    If Text_t(i).Text = "" Then
                        YesNo_str = MsgBox("请先录入设备卡片！ ", 32 + vbYes, "新世纪/ERP5.0-设备管理")
                        If YesNo_str = vbNo Then Exit Sub
                        Exit Sub
                    Else
                        StrTemp = Text_t(i).Text
                        If AddExit_TF = True Then
                            TF_Save = False
                            YesNo_Judge
                            If TF_Save = False Then
                                Exit Sub
                            End If
                        End If
                            Exit For
                            TF_Save = False
                    End If
                End If
            Next i
            Dev_DamagForm.Show 1
        
        Case 4
            If T_Label.Count < 2 Then
                MsgBox "没有项目! ", vbInformation, "新世纪/ERP5.0-设备管理"
                Exit Sub
            End If
            For i = 1 To T_Label.Count - 1
                If Mid(T_Label(i).Tag, 1, Len(T_Label(i).Tag) - 1) = "DEVID" Then
                    If Text_t(i).Text = "" Then
                        YesNo_str = MsgBox("请先录入设备卡片！ ", 32 + vbYes, "新世纪/ERP5.0-设备管理")
                        If YesNo_str = vbNo Then Exit Sub
                        Exit Sub
                    Else
                        StrTemp = Text_t(i).Text
                        If AddExit_TF = True Then
                            TF_Save = False
                            YesNo_Judge
                            If TF_Save = False Then
                                Exit Sub
                            End If
                        End If
                            Exit For
                            TF_Save = False
                    End If
                End If
            Next i
            Dev_FileForm.Show 1
        
    End Select
    
End Sub

Public Sub Form_Load()
    XtReportCode = "Dev_maincard"
    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_V_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) = "DEVID" 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
        '-------------------