frmnewform.frm

用vb写的饮食管理系统功能全面

         TabIndex        =   13
         Top             =   870
         Width           =   540
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "客户名称:"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   0
         Left            =   375
         TabIndex        =   12
         Top             =   510
         Width           =   810
      End
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00808080&
      Index           =   0
      X1              =   30
      X2              =   30
      Y1              =   0
      Y2              =   3420
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00808080&
      Index           =   0
      X1              =   30
      X2              =   7620
      Y1              =   0
      Y2              =   0
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00E0E0E0&
      Index           =   1
      X1              =   60
      X2              =   7620
      Y1              =   15
      Y2              =   15
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00E0E0E0&
      Index           =   2
      X1              =   60
      X2              =   7710
      Y1              =   3420
      Y2              =   3420
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00808080&
      Index           =   3
      X1              =   60
      X2              =   7605
      Y1              =   3405
      Y2              =   3405
   End
   Begin VB.Line Line3 
      BorderColor     =   &H00E0E0E0&
      Index           =   0
      X1              =   45
      X2              =   45
      Y1              =   15
      Y2              =   3420
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00808080&
      Index           =   1
      X1              =   7620
      X2              =   7620
      Y1              =   0
      Y2              =   3420
   End
   Begin VB.Line Line3 
      BorderColor     =   &H00E0E0E0&
      Index           =   1
      X1              =   7620
      X2              =   7620
      Y1              =   0
      Y2              =   3390
   End
End
Attribute VB_Name = "frmNewForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ChangeTrue As Boolean
Dim NoChange As Boolean, lShow As Boolean, lShowS As Boolean

Private Sub ExitB_Click()
 
Unload Me

End Sub

Private Sub Form_Load()

'On Error Resume Next
Me.Left = Val(GetSetting(App.EXEName, "AddNew", "Left", 1000))
Me.Top = Val(GetSetting(App.EXEName, "AddNew", "Top", 1000))

ChangeTrue = False
Me.Caption = "正在添加新客户"
NoChange = False: lShow = False: lShowS = False

End Sub

Private Sub Form_Unload(Cancel As Integer)

 SaveSetting App.EXEName, "AddNew", "Left", Me.Left
 SaveSetting App.EXEName, "AddNew", "Top", Me.Top
  
If ChangeTrue = True Then
   Dim OK As Integer
   OK = MsgBox("有添加记录，需要保存码？(Y/N)", vbYesNo + 32, "未保存")
   If OK = 7 Then
    If IT = True And NoChange = True Then
     'Call frmManager.cmdLoad_Click
    End If
      Unload Me
      Exit Sub
   Else
   '保存记录代码
      Call SaveAdd_Click
       If IT = True And NoChange = True Then
          'Call frmManager.cmdLoad_Click
       End If
      Exit Sub
   End If
Else
  If IT = True And NoChange = True Then
   'Call frmManager.cmdLoad_Click
  End If
   Unload Me
End If

End Sub

Private Sub SaveAdd_Click()

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

'检查卡号
 If CheckProduct("Detail", "卡号", Trim(txtFields(1).Text), 1) <> "" Then
    MsgBox "卡号重复，不能保存!", vbOKOnly + 64, "卡号不能为空"
    txtFields(1).SetFocus
    Exit Sub
 End If
'Save Data
  '**************** 开始 *****************
   DBEngine.BeginTrans
   Dim DB As Database, EF As Recordset, x As Integer, tempStr As String
  
  Set DB = OpenDatabase(ConData, False, False, Constr)
  Set EF = DB.OpenRecordset("Detail", dbOpenDynaset, dbOptimistic)
      EF.AddNew
      EF.Fields("Name") = txtFields(0).Text
      EF.Fields("卡号") = txtFields(1).Text
      EF.Fields("性别") = txtFields(2).Text
      EF.Fields("电话") = txtFields(3).Text
      EF.Fields("传真") = txtFields(4).Text
      EF.Fields("传呼") = txtFields(5).Text
      EF.Fields("手机") = txtFields(6).Text
      EF.Fields("邮件") = txtFields(7).Text
      EF.Fields("地址") = txtFields(8).Text
      EF.Update
      EF.Close
      DB.Close
   DBEngine.CommitTrans
  
  '指针调回编号
   For x = 0 To 8
       txtFields(x).Text = ""
   Next
   
   txtFields(0).SetFocus
   
  '**************** 结束 *****************
  ChangeTrue = False
  NoChange = True
  
  Call frmMember.mnuRefresh_Click  '刷新数据
  
End Sub

Private Sub txtFields_Change(Index As Integer)
 
 ChangeTrue = True
 
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 = 0 Then
   Dim DB As Database, EF As Recordset, tempStr As String
   Set DB = OpenDatabase(ConData, False, False, Constr)
   Set EF = DB.OpenRecordset("Detail", dbOpenDynaset)
       tempStr = "Name='" & txtFields(0).Text & "'"
       EF.FindFirst tempStr
   If Not EF.NoMatch Then
        MsgBox "重复的客户名称,请修改!", vbOKOnly + 48, "警告!"
        DB.Close
        txtFields(0).Text = ""
        txtFields(0).SetFocus
        Exit Sub
       Else
        DB.Close
   End If
End If
End Sub