form2staff.frm

一套收费计算机系统

  List1.RemoveItem 2
  List1.AddItem pstring, 2
  End If
  Case "价格管理"
  If List1.List(3) <> "价格管理" Then
  List1.RemoveItem 3
  List1.AddItem pstring, 3
  End If
  Case "预设地址"
  If List1.List(4) <> "预设地址" Then
  List1.RemoveItem 4
  List1.AddItem pstring, 4
  End If
  Case "收费"
  If List1.List(5) <> "收费" Then
  List1.RemoveItem 5
  List1.AddItem pstring, 5
  End If
  Case "单项查询"
  If List1.List(6) <> "单项查询" Then
  List1.RemoveItem 6
  List1.AddItem pstring, 6
  End If
  Case "组合查询"
  If List1.List(7) <> "组合查询" Then
  List1.RemoveItem 7
  List1.AddItem pstring, 7
  End If
  Case "模糊查询"
  If List1.List(8) <> "模糊查询" Then
  List1.RemoveItem 8
  List1.AddItem pstring, 8
  End If
  Case "日收费查询"
  If List1.List(9) <> "日收费查询" Then
  List1.RemoveItem 9
  List1.AddItem pstring, 9
  End If
  Case "月收费查询"
  If List1.List(10) <> "月收费查询" Then
  List1.RemoveItem 10
  List1.AddItem pstring, 10
  End If
  Case "欠费查询"
  If List1.List(11) <> "欠费查询" Then
  List1.RemoveItem 11
  List1.AddItem pstring, 11
  End If
  Case "生成日报表"
  If List1.List(12) <> "生成日报表" Then
  List1.RemoveItem 12
  List1.AddItem pstring, 12
  End If
  Case "生成月报表"
  If List1.List(13) <> "生成月报表" Then
  List1.RemoveItem 13
  List1.AddItem pstring, 13
  End If
  Case "自助报表"
  If List1.List(14) <> "自助报表" Then
  List1.RemoveItem 14
  List1.AddItem pstring, 14
  End If
  Case "报表查询"
  If List1.List(15) <> "报表查询" Then
  List1.RemoveItem 15
  List1.AddItem pstring, 15
  End If
  Case "修改用户档案"
  If List1.List(16) <> "修改用户档案" Then
  List1.RemoveItem 16
  List1.AddItem pstring, 16
  End If
  Case "改变操作员"
  If List1.List(17) <> "改变操作员" Then
  List1.RemoveItem 17
  List1.AddItem pstring, 17
  End If
  Case "操作记录"
  If List1.List(18) <> "操作记录" Then
  List1.RemoveItem 18
  List1.AddItem pstring, 18
  End If
End Select
  
comd1.Enabled = False

If list2.ListCount = 0 Then '赋值权限为空时，确认·不可用
comd2.Enabled = False
Else
comd2.Enabled = True
End If
End Sub

Private Sub Text1_Change()
If Text1.Text = "" Then
Command1.Enabled = False
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If Len(Text1.Text) < 4 Then ' 当输入小于四个字时
 
  If KeyAscii = 13 Then '回车键
  dflag = True
  
    If Text1.Text = "" Then
      MsgBox "姓名不得为空", vbOKOnly, "警示"
      Text1.SetFocus
      Exit Sub
    Else
            
      If Adodc1.Recordset.RecordCount <> 0 Then
        Adodc1.Recordset.MoveFirst
        Adodc1.Recordset.Find "操作员='" & Trim(Text1.Text) & "'", , adSearchForward, 1
          If Not Adodc1.Recordset.EOF Then '找到同名
            Text1.IMEMode = 2
            Command1.Enabled = True
            Command1.Caption = "确  定"
            Command2.Enabled = False
            Command1.SetFocus
            
            nflag = True '旧用户
            flagpassword = Adodc1.Recordset.Fields(2).Value '记住此人密码
          Else '新添姓名
            Text1.IMEMode = 2
            Command1.Enabled = True
            Command2.Enabled = False
            Command1.SetFocus
          End If
      Else
            Text1.IMEMode = 2
            Command1.Enabled = True
            Command2.Enabled = False
            Command1.SetFocus
            End If
      
    End If
  End If
 
End If

If Len(Text1.Text) = 4 Then '当输入等于四个字时
  If KeyAscii = 13 Then '回车键
   dflag = True
   
        If Adodc1.Recordset.RecordCount <> 0 Then
          Adodc1.Recordset.MoveFirst
          Adodc1.Recordset.Find "操作员='" & Trim(Text1.Text) & "'", , adSearchForward, 1
            If Not Adodc1.Recordset.EOF Then '找到同名
              Text1.IMEMode = 2
              Command1.Enabled = True
              Command1.Caption = "确  定"
              Command2.Enabled = False
              Command1.SetFocus
              
              nflag = True '旧用户
              flagpassword = Adodc1.Recordset.Fields(2).Value '记住此人密码
            Else '新添姓名
              Text1.IMEMode = 2
              Command1.Enabled = True
              Command2.Enabled = False
              Command1.SetFocus
            End If
        Else
            Text1.IMEMode = 2
            Command1.Enabled = True
            Command2.Enabled = False
            Command1.SetFocus
        End If
          
  Else
  
          If KeyAscii <> 8 Then '回撤键
            KeyAscii = 0
          End If
  End If
End If

If Len(Text1.Text) > 4 Then '当输入大于四个字时
  KeyAscii = 0 '取消输入
End If

End Sub

Private Sub textp1_KeyPress(KeyAscii As Integer)
'第一次密码的输入
  If (KeyAscii >= 48 And KeyAscii <= 57) Or (KeyAscii >= 97 And KeyAscii <= 122) Or KeyAscii = 13 Or KeyAscii = 8 Then
    If Len(textp1.Text) < 5 Then '当输入小于5个字符时
      If KeyAscii = 13 Then
        If textp1.Text = "" Then
          MsgBox "密码不得为空", vbOKOnly, "警示"
          textp1.SetFocus
          Exit Sub
        Else
          If nflag = False Then '新用户
            textp2.SetFocus
          Else '旧用户
            If textp1.Text = flagpassword Then '旧用户密码相符
               textp2.SetFocus
            Else
               MsgBox "密码不符，请重新输入", vbOKOnly, "警示"
               textp1.SetFocus
            End If
          End If
        End If
      End If
    End If
  
    If Len(textp1.Text) = 5 Then '当输入等于5个字符时
      If KeyAscii = 13 Then '回车键
        If nflag = False Then '新用户
            textp2.SetFocus
          Else '旧用户
            If textp1.Text = flagpassword Then '旧用户密码相符
               textp2.SetFocus
            Else
               MsgBox "密码不符，请重新输入", vbOKOnly, "警示"
               textp1.SetFocus
            End If
          End If
      Else
        If KeyAscii <> 8 Then '回撤键
          KeyAscii = 0
        End If
      End If
    End If
    
    If Len(textp1.Text) > 5 Then '当输入大于5个字时
    KeyAscii = 0 '取消输入
    End If
  
Else
    KeyAscii = 0
End If
End Sub

Private Sub textp2_KeyPress(KeyAscii As Integer)
'第二次密码的输入
  If (KeyAscii >= 48 And KeyAscii <= 57) Or (KeyAscii >= 97 And KeyAscii <= 122) Or KeyAscii = 13 Or KeyAscii = 8 Then
    If Len(textp2.Text) < 5 Then '当输入小于5个字符时
      If KeyAscii = 13 Then
        If textp2.Text = "" Then
          MsgBox "密码不得为空", vbOKOnly, "警示"
          textp2.SetFocus
          Exit Sub
        Else
          If textp1.Text = textp2.Text Then '密码相符
          
            If nflag = False Then '新用户
              Adodc1.Recordset.Requery '这是对adodc1进行二次update的关键
              Adodc1.Recordset.Find "操作员='" & flagname & "'", , adSearchForward, 1
              Adodc1.Recordset.Fields(2).Value = textp2.Text
              Adodc1.Recordset.Update
            End If
            '------------------
            dflag1 = False '赋第一次扩展为假
            dflag2 = True '赋第二次扩展为真
            
            Timer1.Interval = 10
  
            Form2staff.Controls.Add "vb.line", "linep2"
            With Form2staff.Controls("linep2")
            .Visible = True
            .BorderColor = &H80000003
            .BorderStyle = 6
            .X1 = Form2staff.Width - 200
            .Y1 = 0
            .X2 = Form2staff.Width - 200
            .Y2 = Form2staff.Height
            End With
            
          Else
            MsgBox "密码不符，请重新输入", vbOKOnly, "警示"
            textp1.SetFocus
          End If
        End If
      End If
    End If
  
    If Len(textp2.Text) = 5 Then '当输入等于5个字符时
      If KeyAscii = 13 Then '回车键
          If textp1.Text = textp2.Text Then '密码相符
          
            If nflag = False Then '新用户
              Adodc1.Recordset.Requery  '这是对adodc1进行二次update的关键
              Adodc1.Recordset.Find "操作员='" & flagname & "'", , adSearchForward, 1
              Adodc1.Recordset.Fields(2).Value = textp2.Text
              Adodc1.Recordset.Update
            End If
            '------------------
            dflag1 = False '赋第一次扩展为假
            dflag2 = True '赋第二次扩展为真
            
            Timer1.Interval = 10
  
            Form2staff.Controls.Add "vb.line", "linep2"
            With Form2staff.Controls("linep2")
            .Visible = True
            .BorderColor = &H80000003
            .BorderStyle = 6
            .X1 = Form2staff.Width - 200
            .Y1 = 0
            .X2 = Form2staff.Width - 200
            .Y2 = Form2staff.Height
            End With
             
          Else
            MsgBox "密码不符，请重新输入", vbOKOnly, "警示"
            textp1.SetFocus
          End If
      Else
        If KeyAscii <> 8 Then '回撤键
          KeyAscii = 0
        End If
      End If
    End If
    
    If Len(textp2.Text) > 5 Then '当输入大于5个字时
    KeyAscii = 0 '取消输入
    End If
  
Else
    KeyAscii = 0
End If
End Sub

Private Sub Timer1_Timer()
If dflag1 Then '第一次扩展为真
  Text1.Enabled = False
  Command1.Enabled = False
  Command2.Enabled = False
'  DataList1.Enabled = False
  
  dflag = True
  
  If Me.Width <= 3995 Then
    Me.Width = Me.Width + 250
  Else
    
    Timer1.Interval = 0
    
    Form2staff.Controls.Add "vb.label", "labelp1"
      With Form2staff.Controls("labelp1")
      .Visible = True
      .Left = 2000
      .Top = 225
      .Width = 1500
      .Caption = "请输入密码："
      End With
      
    Set textp1 = Controls.Add("vb.textbox", "textn1")
      With textp1
      .Visible = True
      .Left = 2000
      .Top = 600
      .Height = 200
      .Width = 1500
      .Text = ""
      .PasswordChar = "*"
      .SetFocus
      End With
      
      Form2staff.Controls.Add "vb.label", "labelp2"
      With Form2staff.Controls("labelp2")
      .Visible = True
      .Left = 2000
      .Top = 1065
'      .Width = 2100
      .AutoSize = True
      .Caption = "再次输入密码以确认："
      End With
      
    Set textp2 = Controls.Add("vb.textbox", "textn2")
      With textp2
      .Visible = True
      .Left = 2000
      .Top = 1490
      .Height = 200
      .Width = 1500
      .Text = ""
      .PasswordChar = "*"
      End With
  
  End If
End If

If dflag2 Then '第二次扩展为真
textp1.Enabled = False
textp2.Enabled = False

dflag = True

DataList1.BoundText = flagname '使选定的姓名蓝底白字

  If Me.Width <= 8495 Then
    Me.Width = Me.Width + 250
  Else
    
    Timer1.Interval = 0
    
    Form2staff.Controls.Add "vb.label", "labelp3"
      With Form2staff.Controls("labelp3")
      .Visible = True
      .Left = 4200
      .Top = 225
      .Width = 1200
      .Caption = "所有权限："
      End With
      
    Set List1 = Controls.Add("vb.listbox", "list1n")
      With List1
      .Visible = True
      .Left = 4200
      .Top = 600
      .Height = 3200
      .Width = 1645
      End With
    
    '为list1赋所有权限
    If nflag = False Then '新名
      Adodc2.Refresh
      Adodc2.Recordset.MoveFirst
        Do While Not Adodc2.Recordset.EOF
          List1.AddItem Adodc2.Recordset.Fields(1).Value
          Adodc2.Recordset.MoveNext
        Loop
    End If
    
    If nflag = True Then '同名
      Adodc2.Refresh
      Adodc2.Recordset.MoveFirst
      rstable1.Filter = "姓名='" & flagname & "'"
        Do While Not Adodc2.Recordset.EOF
          rstable1.MoveFirst
          rstable1.Find "操作选择='" & Adodc2.Recordset.Fields(1).Value & "'", , adSearchForward, 1
            If rstable1.EOF Then
              List1.AddItem Adodc2.Recordset.Fields(1).Value
            Else
              List1.AddItem " "
            End If
          Adodc2.Recordset.MoveNext
        Loop
      rstable1.Filter = adFilterNone
    End If
        
    Set comd1 = Controls.Add("cscmd.cscmdctrl.1", "command3")
      Set comd1.Picture = LoadPicture("c:\my documents\arw06rt.ico")
      With comd1
      .Visible = True
      .Left = 6005
      .Top = 800
      .Height = 625
      .Width = 745
      .Caption = "添  加"
      .BevelWidth = 2
      .BorderStyle = 1
      .CaptionPosition = 1
      .ChiselText = 1
      .Enabled = False
      End With
      
      Set comd2 = Controls.Add("cscmd.cscmdctrl.1", "command4")
      Set comd2.Picture = LoadPicture("c:\my documents\arw09lt.ico")
      With comd2
      .Visible = True
      .Left = 6005
      .Top = 2800
      .Height = 625
      .Width = 745
      .Caption = "确  定"
      .BevelWidth = 2
      .BorderStyle = 1
      .CaptionPosition = 1
      .ChiselText = 1
      .Enabled = False
      End With
      
      Form2staff.Controls.Add "vb.label", "labelp4"
      With Form2staff.Controls("labelp4")
      .Visible = True
      .Left = 6860
      .Top = 225
      .Width = 1200
      .Caption = "赋值权限："
      End With
      
    Set list2 = Controls.Add("vb.listbox", "list2n")
      With list2
      .Visible = True
      .Left = 6860
      .Top = 600
      .Height = 3250
      .Width = 1645
      End With
    
    If nflag = True Then '旧用户
      '为list2赋赋值权限
      rstable1.Filter = "姓名='" & flagname & "'"
      rstable1.MoveFirst
      Do While Not rstable1.EOF
      list2.AddItem rstable1.Fields(2).Value
      rstable1.MoveNext
      Loop
      rstable1.Filter = adFilterNone
    End If
        
  End If

End If
End Sub