frmdataadm_bkup.frm

采用面向负荷控制技术

         _Version        =   393216
         HeadLines       =   1
         RowHeight       =   15
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
   End
   Begin VB.CommandButton cmd_exit 
      Caption         =   "退出"
      Height          =   495
      Left            =   9120
      TabIndex        =   0
      Top             =   6360
      Width           =   975
   End
End
Attribute VB_Name = "frmDataAdm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mconn As New ADODB.Connection
Dim mrs_d As New ADODB.Recordset
Dim mrs_dc As New ADODB.Recordset
Dim mrs_p As New ADODB.Recordset
Dim mrs_bom As New ADODB.Recordset
Dim mrs_opr As New ADODB.Recordset
'

Private Sub bom_txt_LostFocus(Index As Integer)
Dim sql As String
Dim rs0 As New ADODB.Recordset
Select Case Index
    Case 1
        Me.MousePointer = ccHourglass
        sql = "select fname from t_bom where father='"
        sql = sql & bom_txt(Index).Text & "'"
        rs0.CursorLocation = adUseClient
        rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
        If rs0.RecordCount = 0 Then
            bom_txt(2) = "not found"
        Else
            rs0.MoveFirst
            bom_txt(2) = rs0(0)
        End If
        rs0.Close
        Me.MousePointer = ccDefault
    Case 3
        Me.MousePointer = ccHourglass
        sql = "select sname from t_bom where son='"
        sql = sql & bom_txt(Index).Text & "'"
        rs0.CursorLocation = adUseClient
        rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
        If rs0.RecordCount = 0 Then
            bom_txt(4) = "not found"
        Else
            rs0.MoveFirst
            bom_txt(4) = rs0(0)
        End If
        rs0.Close
        Me.MousePointer = ccDefault
End Select
End Sub

Private Sub cbo_dno_click()
Dim sql As String, rs0 As New ADODB.Recordset
'sql = "select devicename from device where deviceno='" & cbo_dno & "'"
'rs0.CursorLocation = adUseClient
'rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
'If rs0.RecordCount <> 0 Then
'    rs0.MoveFirst
'    cbo_dname = rs0(0)
'End If
'rs0.Close
End Sub

Private Sub cbo_dname_click()
'Dim sql As String, rs0 As New ADODB.Recordset
'sql = "select deviceno from device where devicename='" & cbo_dname & "'"
'rs0.CursorLocation = adUseClient
'rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
'If rs0.RecordCount <> 0 Then
'    rs0.MoveFirst
'    cbo_dno = rs0(0)
'End If
'rs0.Close
End Sub


Private Sub dgd_opr_Click()
txt_name.Text = mrs_opr("username")
cmb_group.Text = mrs_opr("groupname")
Select Case mrs_opr("power")
    Case "0"
    optSys.Value = True
    Case "1"
    optTra.Value = True
    Case "2"
    optOpr.Value = True
End Select
End Sub

Private Sub pro_txt_LostFocus(Index As Integer)
Dim sql As String
Dim rs0 As New ADODB.Recordset
Select Case Index
    Case 0
        Me.MousePointer = ccHourglass
        sql = "select partname from t_spbillofmaterial where pardrawingnumber='"
        sql = sql & pro_txt(Index).Text & "'"
        rs0.CursorLocation = adUseClient
        rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
        If rs0.RecordCount = 0 Then
            pro_txt(1) = "not found"
        Else
            rs0.MoveFirst
            pro_txt(1) = rs0(0)
        End If
        rs0.Close
        Me.MousePointer = ccDefault
    Case 5
        Me.MousePointer = ccHourglass
        sql = "select partname from t_spbillofmaterial where pardrawingnumber='"
        sql = sql & pro_txt(Index).Text & "'"
        rs0.CursorLocation = adUseClient
        rs0.Open sql, mconn, adOpenKeyset, adLockPessimistic
        If rs0.RecordCount = 0 Then
            pro_txt(6) = "not found"
        Else
            rs0.MoveFirst
            pro_txt(6) = rs0(0)
        End If
        rs0.Close
        Me.MousePointer = ccDefault
End Select
    
End Sub

Private Sub Form_Load()
mconn.Open gConnstr, "harry"
SSTab1.Tab = 0
Me.WindowState = 2
End Sub

Private Sub cmd_cancel_Click()
  cmd_add.Enabled = True
  cmd_del.Enabled = True
  cmd_ok.Enabled = False
  cmd_cancel.Enabled = False
  If SSTab1.Tab = 0 Then
    dgd_deviceclass.Enabled = True
    'Call opendeviceclass
  ElseIf SSTab1.Tab = 1 Then
    dgd_device.Enabled = True
    'Call opendevice
    
  ElseIf SSTab1.Tab = 2 Then
        dgd_process.Enabled = True
        'Call openprocess
        'Call setprocess_additem
  ElseIf SSTab1.Tab = 3 Then
        dgd_bom.Enabled = True
        'call openbom
  End If
End Sub
Private Sub cmd_exit_Click()
    'On Error Resume Next
    Set mrs_d = Nothing
    Set mrs_dc = Nothing
    Set mrs_p = Nothing
    Set mconn = Nothing
    Unload Me
    fMainForm.mnuData.Enabled = True
End Sub
Private Sub cmd_add_Click()
Dim i As Integer
    cmd_add.Enabled = False
    cmd_del.Enabled = False
    cmd_ok.Enabled = True
    cmd_cancel.Enabled = True
  If SSTab1.Tab = 0 Then
    dgd_deviceclass.Enabled = False
    For i = 0 To mrs_dc.Fields.Count - 2
       'mrs_dc.Fields(i) = ""
    Next
  ElseIf SSTab1.Tab = 1 Then
    dgd_device.Enabled = False
    For i = 0 To mrs_d.Fields.Count - 2
        'd_txt(i).Text = ""
    Next
    d_txt(0).SetFocus

  ElseIf SSTab1.Tab = 2 Then
        dgd_process.Enabled = False
        For i = 0 To mrs_p.Fields.Count - 2
         'if i<>2 then
         '  pro_txt(i)=""
         'endif
         '
        Next
        Call setprocess_additem
    pro_txt(0).SetFocus
  ElseIf SSTab1.Tab = 3 Then
        dgd_bom.Enabled = False
        For i = 0 To mrs_bom.Fields.Count - 2
         'if i<>2 then
         '  pro_txt(i)=""
         'endif
         '
        Next
        'Call setprocess_additem
    bom_txt(0).SetFocus
  ElseIf SSTab1.Tab = 4 Then
        dgd_opr.Enabled = False
        For i = 0 To mrs_opr.Fields.Count - 2
         'if i<>2 then
         '  pro_txt(i)=""
         'endif
         '
        Next
        Call setopr_additem
    txt_name.SetFocus
   End If
End Sub
Private Sub cmd_Del_Click()
'On Error GoTo ErrMsg
   If SSTab1.Tab = 0 Then
     If DeviceExist(mrs_dc("model")) Then
        MsgBox "尚有设备存在，不能删除该设备类", vbOKOnly
        Exit Sub
     End If
       mrs_dc.Delete
       If mrs_dc.EOF Then
        mrs_d.MoveLast
       Else
        mrs_dc.MoveNext
       End If
       Call opendeviceclass
   End If
   If SSTab1.Tab = 1 Then
     If DeviceLoadExist(mrs_d("deviceno")) Then
        MsgBox "尚有设备负载存在，不能删除该设备", vbOKOnly
        Exit Sub
     End If
       mrs_d.Delete
       If mrs_d.EOF Then
        mrs_d.MoveLast
       Else
        mrs_d.MoveNext
       End If
       Call opendevice
   End If
   If SSTab1.Tab = 2 Then
       mrs_p.Delete
       If mrs_p.EOF Then
        mrs_d.MoveLast
       Else
       mrs_p.MoveNext
       End If
       Call openprocess
   End If
   If SSTab1.Tab = 3 Then
       mrs_bom.Delete
       If mrs_bom.EOF Then
        mrs_bom.MoveLast
       Else
       mrs_bom.MoveNext
       End If
       Call openbom
   End If
   If SSTab1.Tab = 4 Then
    mrs_opr.Delete
    If mrs_opr.EOF Then
        mrs_opr.MoveLast
    Else
        mrs_opr.MoveNext
    End If
    Call openopr
   End If
   Exit Sub
ErrMsg:
    MsgBox Err.Description, vbExclamation, "信息- Delete"
End Sub
Private Sub cmd_ok_Click()
Dim i As Integer
'On Error GoTo ErrMsg
  If SSTab1.Tab = 0 Then
      mrs_dc.AddNew
      For i = 0 To mrs_dc.Fields.Count - 2
         mrs_dc.Fields(i) = Trim(dc_txt(i).Text)
      Next
      mrs_dc.Update
      dgd_deviceclass.Enabled = True
      Call opendeviceclass
  ElseIf SSTab1.Tab = 1 Then
      mrs_d.AddNew
      For i = 0 To mrs_d.Fields.Count - 2
         mrs_d.Fields(i) = Trim(d_txt(i).Text)
      Next
    mrs_d.Update
    dgd_device.Enabled = True
    Call opendevice

  ElseIf SSTab1.Tab = 2 Then
    mrs_p.AddNew
    For i = 0 To mrs_p.Fields.Count - 2
        If i <> 4 Then
            mrs_p.Fields(i) = Trim(pro_txt(i))
        End If
    Next
    mrs_p.Fields(4) = Trim(cbo_dno.Text)
    mrs_p.Update
    dgd_process.Enabled = True
    Call openprocess
  ElseIf SSTab1.Tab = 3 Then
    mrs_bom.AddNew
    For i = 0 To mrs_bom.Fields.Count - 2
            mrs_bom.Fields(i) = Trim(bom_txt(i))
    Next
    mrs_bom.Update
    dgd_bom.Enabled = True
    Call openbom