设备台帐.frm

新世纪ERP设备管理源代码

               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