X2              =   6120
      Y1              =   3060
      Y2              =   3060
   End
   Begin VB.Line Line6 
      BorderColor     =   &H00FFFFFF&
      Index           =   1
      X1              =   6120
      X2              =   6120
      Y1              =   3480
      Y2              =   3060
   End
   Begin VB.Line Line7 
      BorderColor     =   &H00FFFFFF&
      Index           =   1
      X1              =   4920
      X2              =   6120
      Y1              =   3480
      Y2              =   3480
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      Index           =   2
      X1              =   30
      X2              =   7620
      Y1              =   3630
      Y2              =   3630
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00808080&
      Index           =   3
      X1              =   30
      X2              =   7605
      Y1              =   3615
      Y2              =   3615
   End
End
Attribute VB_Name = "frmAddForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Dim ChangeTrue As Boolean
Dim NoChange As Boolean, lShow As Boolean, lShowS As Boolean
Dim sName As String, sReName As String

Public sCardNO As String        '原來卡號或編號

Private Sub ExitB_Click()
 
    Unload Me

End Sub

Private Sub GetOldSheet(stmpID As String)
    
  On Error GoTo GetERR
  
  Dim mDB As Connection
  Dim mRS As Recordset
  Set mDB = CreateObject("ADODB.Connection")
  Set mRS = CreateObject("ADODB.Recordset")
      mDB.Open Constr
      mRS.Open "Select * from tbdMember Where ID='" & stmpID & "'", mDB, adOpenStatic, adLockReadOnly, adCmdText
      If Not (mRS.EOF And mRS.BOF) Then
        '有找到會員時
         txtFields(0).Text = mRS("Name")
         sReName = txtFields(0).Text   '保存原來的姓名
         txtFields(1).Text = stmpID
         txtFields(2).Text = mRS("Sex")
         txtFields(3).Text = mRS("Tel")
         txtFields(4).Text = NullValue(mRS("Fax"))
         txtFields(5).Text = NullValue(mRS("BP"))
         txtFields(6).Text = NullValue(mRS("Mobil"))
         txtFields(7).Text = NullValue(mRS("Email"))
         txtFields(8).Text = NullValue(mRS("Address"))
         cmbLevel.ListIndex = mRS("DLevel")
         txtRemain.Text = mRS("Consume")
       Else
         mRS.Close: mDB.Close
         Set mRS = Nothing
         Set mDB = Nothing
         Dim x As Integer
        '使所有失效
         For x = 0 To 8
             txtFields(x).Enabled = False
         Next
         SaveAdd.Enabled = False
         cmbLevel.Enabled = False
         MsgBox "會員編號【" & stmpID & "】不存在？  ", vbExclamation
         Exit Sub
      End If
      
      mRS.Close: mDB.Close
      Set mRS = Nothing
      Set mDB = Nothing
         
  Exit Sub
GetERR:
    MsgBox "給出會員資料錯誤:" & Err.Description, vbCritical
    Exit Sub
 
 
End Sub

Private Sub Form_Load()

    On Error Resume Next
    
   '給出會員信息
    GetOldSheet frmMember.lstPro.SelectedItem.Text
    
   '首先給出該會員的詳細資料
    sName = sReName
 
    GetFormSet Me, Screen
    
    ChangeTrue = False
    NoChange = False: lShow = False: lShowS = False
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    SaveFormSet Me
    Unload Me

End Sub

Private Sub SaveAdd_Click()
 
    On Error GoTo SaveERR
   
   '名稱必須
    If Trim(txtFields(0).Text) = "" Then
       MsgBox "客戶名不能空，且不能重復,不能充值!", vbOKOnly + 64, "客戶名有錯誤"
       txtFields(0).SetFocus
       Exit Sub
    End If
    
   '編號必須
    If Trim(txtFields(1).Text) = "" Then
       MsgBox "編號或卡號不能空，不能充值!", vbOKOnly + 64, "卡號不能為空"
       txtFields(1).SetFocus
       Exit Sub
    End If
   
   '充值金額為0，或者不正常數字時
    If Trim(txtCHUN.Text) = "" Or Trim(txtCHUN.Text) = "0" Then
       MsgBox "充值金額為空!", vbOKOnly + 64, "充值金額不能為空，或者為非法字符。"
       txtCHUN.SetFocus
       Exit Sub
    End If
    
   '充值金額為0，或者不正常數字時
    If IsNumeric(txtCHUN.Text) = False Then
       MsgBox "充值金額為非數字!", vbOKOnly + 64, "充值金額不能為非法字符。"
       txtCHUN.SetFocus
       Exit Sub
    End If
     
   If MsgBox("真的要充值【" & txtCHUN.Text & "元】嗎？" & vbCrLf & vbCrLf & "按確定按鈕執行充值,按取消返回。", vbInformation + vbYesNo) = vbNo Then Exit Sub
   
   sArrearagePaymethod = ""
   
  '顯示付款方式
   frmShowPayMethod.Show 1
   
   If sArrearagePaymethod = "" Then
      MsgBox "付款方式為空，不能充值？  ", vbExclamation
      Exit Sub
   End If

  '**************** 開始 *****************
   Dim DB As Connection, EF As Recordset, x As Integer, tempStr As String
   Dim tmpRs As Recordset
   
   Set DB = CreateObject("ADODB.Connection")
   Set tmpRs = CreateObject("ADODB.Recordset")
   Set EF = CreateObject("ADODB.Recordset")
       DB.Open Constr
       DB.BeginTrans
       Dim sSQL As String
       sSQL = "Select * from tbdMember Where ID='" & Trim(txtFields(1).Text) & "'"
       EF.Open sSQL, DB, adOpenStatic, adLockOptimistic, adCmdText
       If Not (EF.EOF And EF.BOF) Then
          EF.Fields("Consume") = EF.Fields("Consume") + CCur(txtCHUN.Text)
          EF.Update                               '更新
        Else
          EF.Close: DB.Close
          Set EF = Nothing
          Set DB = Nothing
          MsgBox "會員編號沒有找到, 不能充值？ ", vbExclamation
          Exit Sub
       End If
       EF.Close
      '添加現金帳單
       InserToCash DB, 1, "客戶〖" & txtFields(0).Text & "〗卡充值【" & txtCHUN.Text & "元】", CCur(txtCHUN.Text), Date, sArrearagePaymethod
      '修改今日與總金額
       InserTodayCash DB, sArrearagePaymethod, CCur(txtCHUN.Text), Date
      '插入到卡對帳單中
       InserToCard DB, 1, "卡充值 - " & Date, CCur(txtCHUN.Text), Trim(txtFields(1).Text), 0, CCur(txtRemain.Text) + CCur(txtCHUN.Text)
      '---------------------------
       DB.CommitTrans
       DB.Close
       Set EF = Nothing
       Set DB = Nothing
    
       sFindString = ""
       Call frmMember.LoadData
        
       Unload Me  '關閉
  
       Exit Sub
SaveERR:
  MsgBox "充值錯誤:" & Err.Description, vbCritical
  On Error Resume Next
  DB.RollbackTrans
  DB.Close
  Set DB = Nothing
  Exit Sub
  
End Sub

Private Sub txtCHUN_Change()

  On Error Resume Next
  If Trim(txtCHUN.Text) = "" Then
     txtCHUN.Text = "0"
     txtCHUN.SelStart = 0
     txtCHUN.SelLength = 1
     Exit Sub
  End If
  If Trim(txtCHUN.Text) = "." Then
     txtCHUN.Text = "0."
     txtCHUN.SelStart = 2
     txtCHUN.SelLength = 0
     Exit Sub
  End If
  
End Sub

Private Sub txtCHUN_GotFocus()

  On Error Resume Next
  txtCHUN.SelStart = 0
  txtCHUN.SelLength = Len(txtCHUN.Text)
  
End Sub

Private Sub txtCHUN_KeyPress(KeyAscii As Integer)

 '屏蔽一些數據
  If KeyAscii = 13 Then SaveAdd.SetFocus: Exit Sub
  If KeyAscii < 46 And KeyAscii > 57 Then KeyAscii = 0
  If KeyAscii = 47 Then KeyAscii = 0
  
End Sub

Private Sub txtCHUN_LostFocus()

   On Error Resume Next
   If txtCHUN.Text <> "" Then
      If IsNumeric(txtCHUN.Text) = False Then
         MsgBox "請輸入數字,不能為非數字。", vbInformation
         txtCHUN.Text = 0
      End If
   End If
   
End Sub

Private Sub txtFields_Change(Index As Integer)
 
  ChangeTrue = True
  If Index = 2 Then
    If Trim(txtFields(2).Text) = "" Then
       txtFields(2).Text = "男"
       txtFields(2).SelStart = 0
       txtFields(2).SelLength = Len(txtFields(2).Text)
       Exit Sub
    End If
 End If

End Sub

Private Sub txtFields_GotFocus(Index As Integer)

txtFields(Index).BackColor = &HFF0000
txtFields(Index).ForeColor = &HFFFFFF
txtFields(Index).SelStart = 0
txtFields(Index).SelLength = Len(Trim(txtFields(Index).Text))

End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

If KeyCode = 38 Then
   If Index > 0 Then
      txtFields(Index - 1).SetFocus
   End If
End If
If KeyCode = 40 Then
   If Index < 8 Then
      txtFields(Index + 1).SetFocus
   End If
End If

End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)

If KeyAscii = 13 Then
   SendKeys "{tab}"
   Exit Sub
End If
If KeyAscii = 8 Then
   Exit Sub
End If
 
 If Index = 1 Then
    If KeyAscii < 48 Or KeyAscii > 57 Then
       KeyAscii = 0
    End If
 End If
  
 If Index = 2 Then  '性別輸入
    If KeyAscii = 49 Then
       KeyAscii = 0
       txtFields(2).Text = "男"
    End If
    If KeyAscii = 50 Then
       KeyAscii = 0
       txtFields(2).Text = "女"
    End If
    SetItFocus txtFields(2)
    KeyAscii = 0
 End If
 
End Sub

Private Sub txtFields_LostFocus(Index As Integer)

txtFields(Index).BackColor = &HFFFFFF
txtFields(Index).ForeColor = &H0
If InStr(1, txtFields(Index).Text, "'", vbTextCompare) Then
   MsgBox "該項目之中有特殊字符" + "<'>,請刪除。", vbOKOnly + 48, "提示："
   txtFields(Index).SetFocus
   Exit Sub
End If

If Index = 2 Then
    If Trim(txtFields(2).Text) = "" Then
       txtFields(2).Text = "男"
       txtFields(2).SelStart = 0
       txtFields(2).SelLength = Len(txtFields(2).Text)
       Exit Sub
    End If
 End If

End Sub