form2.frm

一套收费计算机系统

  
      lbl收视费.BackColor = &H80FF80
    End If
  End If
  
  If DataGrid1.BackColor = &H8000000F Then
  '筛选状态
    Command1.Enabled = False
    Command2.Enabled = False
    Command4.Enabled = False
    Set txt编号.DataSource = hzzde: txt编号.DataMember = "threeinone": txt编号.Locked = True
    Set txt姓名.DataSource = hzzde: txt姓名.DataMember = "threeinone": txt姓名.Locked = True
    Set cbo地址.DataSource = hzzde: cbo地址.DataMember = "threeinone": cbo地址.Locked = True
    Set txt增装盒.DataSource = hzzde: txt增装盒.DataMember = "threeinone": txt增装盒.Locked = True
    Set txt初装日期.DataSource = hzzde: txt初装日期.DataMember = "threeinone": txt初装日期.Locked = True
    Set txt交费日期.DataSource = hzzde: txt交费日期.DataMember = "threeinone": txt交费日期.Locked = True
    Set txt备注.DataSource = hzzde: txt备注.DataMember = "": txt备注.Locked = True
    
    If Left(DataGrid1.Columns(0).Value, 1) = "1" Then
      lbl类型.Caption = DataGrid1.Columns(3).Value
      lbl类型.BackColor = &HFF8080
      lbl初装费.Caption = DataGrid1.Columns(7).Value
      lbl初装费.BackColor = &HFF8080
      lbl收视费.Caption = DataGrid1.Columns(9).Value
      lbl收视费.BackColor = &HFF8080
    End If
    If Left(DataGrid1.Columns(0).Value, 1) = "2" Then
      lbl类型.Caption = DataGrid1.Columns(3).Value
      lbl类型.BackColor = &H80FF80
      lbl初装费.Caption = DataGrid1.Columns(7).Value
      lbl初装费.BackColor = &H80FF80
      lbl收视费.Caption = DataGrid1.Columns(9).Value
      lbl收视费.BackColor = &H80FF80
    End If
  End If

End If
End Sub

Private Sub Form_Load()
Adodc1.Refresh
Adodc3.Refresh
Adodc4.Refresh

Dim i As Integer
'添加地址列表的项目
Adodc2.Refresh
Adodc2.Recordset.MoveLast '这是正确计算记录数的基础语句
Adodc2.Recordset.MoveFirst
For i = 0 To Adodc2.Recordset.RecordCount
  If Not Adodc2.Recordset.EOF Then
    List1.AddItem Adodc2.Recordset.Fields(1).Value
    Adodc2.Recordset.MoveNext
  Else
    Exit For
  End If
Next i

addstatus = False
dgriddown = False

strcnn = "provider=microsoft.jet.oledb.4.0;data source=c:\my documents\花寨子2000.mdb;" 'initial catalog=pubs;user id=zw;password=;"
Set rstable = New ADODB.Recordset
rstable.CursorLocation = adUseClient
rstable.CursorType = adOpenStatic
rstable.LockType = adLockBatchOptimistic
rstable.Open "用户库", strcnn, , , adCmdTable
If Not rstable.RecordCount = 0 Then
rstable.MoveFirst
End If

StatusBar1.SimpleText = "准备输入新数据"
Command4.Enabled = False '更新按钮不可用
Command2.Enabled = False '删除按钮不可用
Command3.Enabled = False '查找按钮不可用

hzzde.rsonlyprice.Open
hzzde.rsonlyprice.MoveFirst
chen = hzzde.rsonlyprice.Fields(1).Value
cc = hzzde.rsonlyprice.Fields(2).Value
cs = hzzde.rsonlyprice.Fields(3).Value
hzzde.rsonlyprice.MoveLast
nong = hzzde.rsonlyprice.Fields(1).Value
nc = hzzde.rsonlyprice.Fields(2).Value
ns = hzzde.rsonlyprice.Fields(3).Value
hzzde.rsonlyprice.Close

DataGrid1.Splits(0).AllowSizing = False '禁止拆分

entrydate = Now()

End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If addstatus = True Then
MsgBox "此状态下不得退出，请输入完此记录后退出。", vbOKOnly, "警示"
Cancel = True
Else
Call history(staff, entrydate, Me.Caption, Now())
Adodc1.Recordset.Close
'Set Adodc1.Recordset = Nothing
Set Adodc2.Recordset = Nothing
Set rstable = Nothing
'Set hzzde.rsonlyprice = Nothing
'adodc2.Recordset.Close
Unload Me
End If

End Sub


Private Sub List1_DblClick()
cbo地址.Text = List1.Text
cbo地址.SetFocus
'移动光标到字块尾
cbo地址.SelStart = Len(cbo地址.Text)
End Sub

Private Sub txt备注_Change()
If dgriddown Then
  If Screen.ActiveForm.ActiveControl.Name = "txt备注" Then
  Command1.Enabled = False
  Command3.Enabled = False
  Command2.Enabled = False
  End If
End If
End Sub

Private Sub txt备注_GotFocus()
List1.Visible = False
If txt备注.IMEMode <> 1 Then
txt备注.IMEMode = 1
End If
End Sub

Private Sub txt备注_KeyPress(KeyAscii As Integer)
If Len(txt备注.Text) < 10 Then ' 当输入小于十个字时
  If KeyAscii = 13 Then '回车键
  Command4.Enabled = True
  Command4.SetFocus
  txt备注.IMEMode = 2
  StatusBar1.SimpleText = "按更新键更新数据"
  End If
End If

If Len(txt备注.Text) = 10 Then '当输入等于十个字时
  If KeyAscii = 13 Then '回车键
  Command4.Enabled = True
  Command4.SetFocus
  txt备注.IMEMode = 2
  StatusBar1.SimpleText = "按更新键更新数据"
  Else
    If KeyAscii <> 8 Then '回撤键
    KeyAscii = 0
    End If
  End If
End If

If Len(txt备注.Text) > 10 Then '当输入大于十个字时
  KeyAscii = 0 '取消输入
End If
End Sub

Private Sub txt编号_Change()
If dgriddown Then
  If Screen.ActiveForm.ActiveControl.Name = "txt编号" Then
  Command1.Enabled = False
  Command2.Enabled = False
  Command3.Enabled = False
  
  dgriddown = False
  End If
End If
End Sub

Private Sub txt编号_KeyPress(KeyAscii As Integer)

If Len(txt编号.Text) < 6 Then ' 当输入小于六个字母时
  If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 8 Then '除0-9，回撤键外其余的输入无效
  KeyAscii = 0 '取消输入
  End If
End If

If Len(txt编号.Text) = 6 Then '当输入等于六个字母时

  If KeyAscii = 13 Then '回车的处理
      If Left(txt编号.Text, 1) <> 1 And Left(txt编号.Text, 1) <> 2 Then
      MsgBox "输入数据错误，编号必须有六位数字，第一位必须为1或2。", vbOKOnly, "录入错误"
      txt编号.SetFocus
      Else
        If Left(txt编号.Text, 1) = "1" Then
        lbl类型.Caption = chen
        lbl类型.BackColor = &HFF8080
        lbl初装费.Caption = Str(cc)
        lbl初装费.BackColor = &HFF8080
        lbl收视费.Caption = Str(cs)
        lbl收视费.BackColor = &HFF8080
        End If
        If Left(txt编号.Text, 1) = "2" Then
        lbl类型.Caption = nong
        lbl类型.BackColor = &H80FF80
        lbl初装费.Caption = Str(nc)
        lbl初装费.BackColor = &H80FF80
        lbl收视费.Caption = Str(ns)
        lbl收视费.BackColor = &H80FF80
        End If
      Text1.Text = txt编号.Text '为交费库 号码赋值
      Adodc1.Recordset.Fields(6).Value = Date '为当前时间 赋值
      txt姓名.SetFocus
      End If
    End If
    
    If KeyAscii <> 8 Then '回撤键的处理
      KeyAscii = 0 '取消输入
    End If
    
End If
End Sub

Private Sub txt初装日期_Change()
If dgriddown Then
  If Screen.ActiveForm.ActiveControl.Name = "txt初装日期" Then
  Command1.Enabled = False
  Command2.Enabled = False
  Command3.Enabled = False
  End If
End If
End Sub

Private Sub txt初装日期_GotFocus()
List1.Visible = False
If txt初装日期.IMEMode <> 2 Then
txt初装日期.IMEMode = 2
End If
End Sub

Private Sub txt初装日期_KeyPress(KeyAscii As Integer)
On Error GoTo errdata

If Len(txt初装日期.Text) < 8 Then
  If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 13 And KeyAscii <> 8 And KeyAscii <> 45 Then
    KeyAscii = 0
  Else
  If KeyAscii = 13 Then
    If IsDate(txt初装日期.Text) Then
    txt交费日期.SetFocus
    Else
    MsgBox "您的输入有误，请按YY-MM-DD格式输入", vbOKOnly, "警示"
    txt初装日期.SetFocus
    End If
  End If
  End If
End If

If Len(txt初装日期.Text) = 8 Then
 If KeyAscii = 13 Then
    If IsDate(txt初装日期.Text) Then
    txt交费日期.SetFocus
    Else
    MsgBox "您的输入有误，请按YY-MM-DD格式输入", vbOKOnly, "警示"
    txt初装日期.SetFocus
    End If
 End If
 If KeyAscii <> 8 Then '回撤键的处理
      KeyAscii = 0 '取消输入
 End If
 End If
 
 Exit Sub '无错误时，跳过错误处理程序
errdata:
 MsgBox "您的输入有误，请按YY-MM-DD格式输入", vbOKOnly, "警示"
 txt初装日期.SetFocus
 Resume Next
 
End Sub

Private Sub txt交费日期_Change()
If dgriddown Then
  If Screen.ActiveForm.ActiveControl.Name = "txt交费日期" Then
  Command1.Enabled = False
  Command2.Enabled = False
  Command3.Enabled = False
  End If
End If
End Sub

Private Sub txt交费日期_GotFocus()
List1.Visible = False
If txt交费日期.IMEMode <> 2 Then
txt交费日期.IMEMode = 2
End If
End Sub

Private Sub txt交费日期_KeyPress(KeyAscii As Integer)
On Error GoTo errdata

If Len(txt交费日期.Text) < 8 Then
  If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 13 And KeyAscii <> 8 And KeyAscii <> 45 Then
    KeyAscii = 0
  Else
  If KeyAscii = 13 Then
    If IsDate(txt交费日期.Text) Then
    txt备注.SetFocus
    Else
    MsgBox "您的输入有误，请按YY-MM-DD格式输入", vbOKOnly, "警示"
    txt交费日期.SetFocus
    End If
  End If
  End If
End If

If Len(txt交费日期.Text) = 8 Then
 If KeyAscii = 13 Then
    If IsDate(txt交费日期.Text) Then
    txt备注.SetFocus
    Else
    MsgBox "您的输入有误，请按YY-MM-DD格式输入", vbOKOnly, "警示"
    txt交费日期.SetFocus
    End If
 End If
 If KeyAscii <> 8 Then '回撤键的处理
      KeyAscii = 0 '取消输入
 End If
 End If
 
 Exit Sub '无错误时，跳过错误处理程序
errdata:
 MsgBox "您的输入有误，请按YY-MM-DD格式输入", vbOKOnly, "警示"
 txt交费日期.SetFocus
 Resume Next
End Sub

Private Sub txt姓名_Change()
If dgriddown Then
  If Screen.ActiveForm.ActiveControl.Name = "txt姓名" Then
  Command1.Enabled = False
  Command2.Enabled = False
  Command3.Enabled = False
  End If
End If
End Sub

Private Sub txt姓名_KeyPress(KeyAscii As Integer)
If Len(txt姓名.Text) < 4 Then ' 当输入小于四个字时
  If KeyAscii = 13 Then '回车键
  cbo地址.SetFocus
  End If
End If

If Len(txt姓名.Text) = 4 Then '当输入等于四个字时
  If KeyAscii = 13 Then '回车键
  cbo地址.SetFocus
  Else
    If KeyAscii <> 8 Then '回撤键
    KeyAscii = 0
    End If
  End If
End If

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

End Sub

Private Sub txt增装盒_Change()

If dgriddown Then
  If Screen.ActiveForm.ActiveControl.Name = "txt增装盒" Then
  Command1.Enabled = False
  Command2.Enabled = False
  Command3.Enabled = False
  End If
End If

If txt增装盒.Text = "0" Then
Label1.Caption = "无"
Else
Label1.Caption = "有"
End If

End Sub

Private Sub txt增装盒_GotFocus()
List1.Visible = False
txt增装盒.Text = "-1"
If txt增装盒.IMEMode <> 2 Then
txt增装盒.IMEMode = 2
End If
End Sub

Private Sub txt增装盒_KeyPress(KeyAscii As Integer)
If KeyAscii = Asc("0") Or KeyAscii = Asc("-") Or KeyAscii = 32 Or KeyAscii = 13 Then
  If KeyAscii = Asc("0") Then
  Label1.Caption = "无"
  txt增装盒.Text = "0"
  End If
  
  If KeyAscii = Asc("-") Then
     Label1.Caption = "有"
     txt增装盒.Text = "-1"
  End If
  
  If KeyAscii = 32 Then
   If Label1.Caption = "无" Then
      txt增装盒.Text = "-1"
      Label1.Caption = "有"
   Else
      txt增装盒.Text = "0"
      Label1.Caption = "无"
   End If
   End If
   
   If KeyAscii = 13 Then
      If txt增装盒.Text = "0" Or txt增装盒.Text = "-1" Then
      txt初装日期.SetFocus
      End If
    Else
    KeyAscii = 0
    End If
     
  Else
KeyAscii = 0
End If
End Sub