form41.frm

一套收费计算机系统

         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   180
      Index           =   7
      Left            =   75
      TabIndex        =   15
      Top             =   1635
      Width           =   900
   End
   Begin VB.Label lblFieldLabel 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "收视费:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   180
      Index           =   8
      Left            =   5550
      TabIndex        =   14
      Top             =   1665
      Width           =   705
   End
   Begin VB.Label lblFieldLabel 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "备注:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   180
      Index           =   9
      Left            =   465
      TabIndex        =   13
      Top             =   2160
      Width           =   510
   End
   Begin VB.Label lbl类型 
      BorderStyle     =   1  'Fixed Single
      Height          =   405
      Left            =   6360
      TabIndex        =   12
      Top             =   120
      Width           =   1095
   End
   Begin VB.Label lbl初装费 
      BorderStyle     =   1  'Fixed Single
      BeginProperty DataFormat 
         Type            =   1
         Format          =   """￥""#,##0.00"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   2
      EndProperty
      Height          =   435
      Left            =   6360
      TabIndex        =   11
      Top             =   1080
      Width           =   1095
   End
   Begin VB.Label lbl收视费 
      BorderStyle     =   1  'Fixed Single
      BeginProperty DataFormat 
         Type            =   1
         Format          =   """￥""#,##0.00"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   2
      EndProperty
      Height          =   405
      Left            =   6360
      TabIndex        =   10
      Top             =   1560
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "有"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   6840
      TabIndex        =   9
      Top             =   750
      Width           =   375
   End
End
Attribute VB_Name = "Form41"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim chen, nong As String
Dim cc, cs, nc, ns As Integer

Private Sub Command1_Click()
Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields(0).Value = txt编号.Text
Adodc1.Recordset.Fields(1).Value = txt姓名.Text
Adodc1.Recordset.Fields(2).Value = cbo地址.Text
If txt增装盒.Text = "0" Then
Adodc1.Recordset.Fields(4).Value = False
Else
Adodc1.Recordset.Fields(4).Value = True
End If
Adodc1.Recordset.Fields(3).Value = txt初装日期.Text
Adodc1.Recordset.Fields(5).Value = txt备注.Text
Adodc1.Recordset.Fields(6).Value = Date
Adodc1.Recordset.Update
Adodc1.Recordset.Requery

Adodc3.Refresh
Adodc3.Recordset.AddNew
Adodc3.Recordset.Fields(1).Value = txt编号.Text
Adodc3.Recordset.Fields(2).Value = txt交费日期.Text
Adodc3.Recordset.Update
Adodc3.Recordset.Requery

Unload Me
End Sub

Private Sub Command2_Click()
'取消
Adodc1.Recordset.Close
Set Adodc1.Recordset = Nothing
Set Adodc2.Recordset = Nothing
Unload Me

End Sub

Private Sub Form_Load()
Adodc1.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

txt编号.Text = tnumber
txt交费日期.Text = Date

Command1.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

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
  Label3.Caption = Str(cc + cs)
  Label3.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
  Label3.Caption = Str(nc + ns)
  Label3.BackColor = &H80FF80
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 cbo地址_Change()
Dim i As Integer
For i = 0 To List1.ListCount
  If InStr(1, List1.List(i), cbo地址.Text, vbTextCompare) = 1 Then
  List1.ListIndex = i
  Exit For
  Else
  List1.ListIndex = -1
  End If
Next i
End Sub

Private Sub cbo地址_GotFocus()
If IMEStatus <> 1 Then
cbo地址.IMEMode = 1
End If
List1.Visible = True
End Sub

Private Sub cbo地址_KeyPress(KeyAscii As Integer)
If Len(cbo地址.Text) < 10 Then
   If KeyAscii = 13 Then '回车键
    If cbo地址.ListCount < 10 Then
    cbo地址.AddItem cbo地址.Text
    cbo地址.Text = cbo地址.List(cbo地址.ListCount - 1)
    cbo地址.Refresh
    Else
    cbo地址.RemoveItem 9
    cbo地址.AddItem cbo地址.Text, 0
    cbo地址.Text = cbo地址.List(0)
    cbo地址.Refresh
    End If
    List1.Visible = False
    txt增装盒.SetFocus
  End If
End If

If Len(cbo地址.Text) = 10 Then
  If KeyAscii = 13 Then '回车键
      If cbo地址.ListCount < 10 Then
      cbo地址.AddItem cbo地址.Text
      cbo地址.Text = cbo地址.List(cbo地址.ListCount - 1)
      cbo地址.Refresh
      Else
      cbo地址.RemoveItem 9
      cbo地址.AddItem cbo地址.Text, 0
      cbo地址.Text = cbo地址.List(0)
      cbo地址.Refresh
      End If
    List1.Visible = False
    txt增装盒.SetFocus
  Else
      If KeyAscii <> 8 Then '回撤键
      KeyAscii = 0
      End If
  End If
End If


If Len(cbo地址.Text) > 10 Then
 KeyAscii = 0 '取消输入
End If
End Sub


Private Sub cbo地址_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim aa As String
aa = Data.GetData(1)
cbo地址.Text = aa
cbo地址.SetFocus
'移动光标到字块尾
cbo地址.SelStart = Len(cbo地址.Text)
End Sub
Private Sub txt增装盒_Change()
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
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
    Command1.Enabled = True
    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备注_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 '回车键
  Command1.SetFocus
  txt备注.IMEMode = 2
  End If
End If

If Len(txt备注.Text) = 10 Then '当输入等于十个字时
  If KeyAscii = 13 Then '回车键
  Command1.SetFocus
  txt备注.IMEMode = 2
  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 List1_DblClick()
cbo地址.Text = List1.Text
cbo地址.SetFocus
'移动光标到字块尾
cbo地址.SelStart = Len(cbo地址.Text)
End Sub