frmmainsearch.frm

一套比较全面的茶馆控制系统软件源代码

End Sub

Private Sub cmbStyle_LostFocus()

  If cmbStyle.Text = "" Then Exit Sub
  
  If LostControl("MenuType", "MenuName", cmbStyle.Text) = False Then
     MsgBox "[ " + cmbStyle.Text + " ] 为无效的类别名,请重新输入。    ", vbInformation, "请先定义类别名"
     cmbStyle.Text = ""
     cmbStyle.SetFocus
  End If

End Sub

Private Sub cmdClose_Click()

  Unload Me
  
End Sub

Private Sub cmdOK_Click()

  Dim tmpStr As String
     
  '日期
    If txtSellDate.Text <> "____-__-__" And txtSellDateE.Text <> "____-__-__" Then
     tmpStr = " 日期=#" & txtSellDate.Text & "# And 日期=#" & txtSellDateE.Text & "#"
    ElseIf txtSellDateE.Text = "____-__-__" And txtSellDate.Text <> "____-__-__" Then
     tmpStr = " 日期=#" & txtSellDate.Text & "#"
    End If
  
  '店名
  If cmbBranchName.Text <> "" Then
     tmpStr = tmpStr + " And 卡号='" & cmbBranchName & "'"
  End If
  
  '品名
  If txtProductName.Text <> "" Then
      tmpStr = tmpStr + " And 名称='" & Trim(txtProductName.Text) & "'"
  End If
  
  '货号
  If txtNO.Text <> "" Then
      tmpStr = tmpStr + " And 代码='" & Trim(txtNO.Text) & "'"
  End If
  
  '规格
  If cmbStyle.Text <> "" Then
     tmpStr = tmpStr + " And MenuType='" & Trim(cmbStyle.Text) & "'"
  End If
    
  '检查有没有And
  If Left$(tmpStr, 4) = " And" Then
     SCondStr = Right(tmpStr, Len(tmpStr) - 4)
   Else
     SCondStr = tmpStr
  End If
  
  '御载
  Unload Me
  
End Sub

Private Sub cmdSelectDate_Click()

 On Error Resume Next
 
 Me.MousePointer = 11
   Calendar.Show 1
 Me.MousePointer = 0
 
 '代入选择的值
 If Trim(DateStr) = "" Then
    txtSellDate.SetFocus
    Exit Sub
 End If
 
 txtSellDate = DateStr
 If txtSellDateE.Text <> "____-__-__" Then
    chkEndDate.Visible = False
    Label1(5).Visible = True
    txtSellDateE.Visible = True
    cmdSelectDateE.Visible = True
    Label1(5).Enabled = True
    txtSellDateE.Enabled = True
    cmdSelectDateE.Enabled = True
    cmbBranchName.SetFocus
  Else
    chkEndDate.SetFocus
 End If
 
End Sub

Private Sub cmdSelectDateE_Click()

 On Error Resume Next
 
 Me.MousePointer = 11
   Calendar.Show 1
 Me.MousePointer = 0
 
 '代入选择的值
 If Trim(DateStr) = "" Then
    txtSellDateE.SetFocus
    Exit Sub
 End If
 
 txtSellDateE = DateStr
 If cmbBranchName.Enabled = True Then
    cmbBranchName.SetFocus
 End If

End Sub

Private Sub Form_Load()
   
  '装载数据
  Call LoadData
  
End Sub

Private Sub LoadData()

  Dim DB As Database, EF As Recordset
  Dim tmpStr As String
  
  On Error Resume Next

  
  Set DB = OpenDatabase(ConData, False, False, Constr)

  '检查会员卡号
    Set EF = DB.OpenRecordset("Detail", dbOpenDynaset)
      If EF.EOF And EF.BOF Then
         cmbBranchName.Enabled = False
        Else
         Do Until EF.EOF()
            If Not IsNull(EF.Fields(2).Value) Then
               tmpStr = EF.Fields(2).Value
               cmbBranchName.AddItem tmpStr
            End If
            EF.MoveNext
         Loop
      End If
    EF.Close

  '检查分类
  Set EF = DB.OpenRecordset("MenuType", dbOpenDynaset)
      If EF.EOF And EF.BOF Then
         cmbStyle.Enabled = False
        Else
         Do Until EF.EOF()
            If Not IsNull(EF.Fields(1).Value) Then
               tmpStr = EF.Fields(1).Value
               cmbStyle.AddItem tmpStr
            End If
            EF.MoveNext
         Loop
      End If
    EF.Close
    
  '检查品名
  Set EF = DB.OpenRecordset("Select * From EatList", dbOpenDynaset)
      If EF.EOF And EF.BOF Then
         txtProductName.Enabled = False
        Else
         Do Until EF.EOF()
            If Not IsNull(EF.Fields(1).Value) Then
               tmpStr = EF.Fields(1).Value
               txtProductName.AddItem tmpStr
            End If
            EF.MoveNext
         Loop
      End If
    EF.Close
  
  DB.Close

End Sub

Private Sub txtNO_Change()

  Call Valid_OK
  
End Sub

Private Sub txtNO_GotFocus()

  Call GoFocus(txtNO)
  
End Sub

Private Sub txtNO_KeyDown(KeyCode As Integer, Shift As Integer)

  Call MoveToNext(KeyCode)
  
End Sub

Private Sub txtNO_KeyPress(KeyAscii As Integer)

 If KeyAscii = 13 Then
    SendKeys "{tab}"
 End If
 
End Sub

Private Sub txtProductName_Change()

  Call Valid_OK
  
End Sub

Private Sub txtProductName_Click()

  Call Valid_OK
  txtNO.SetFocus   '下一个获焦
  
End Sub

Private Sub txtProductName_KeyDown(KeyCode As Integer, Shift As Integer)

  Call MoveToNext(KeyCode)
  
End Sub

Private Sub txtProductName_KeyPress(KeyAscii As Integer)

 If KeyAscii = 13 Then
    SendKeys "{tab}"
 End If
 
End Sub

Private Sub txtProductName_LostFocus()

  If txtProductName.Text = "" Then Exit Sub
  
  If LostControl("EatList", "名称", txtProductName.Text) = False Then
     MsgBox "[ " + txtProductName.Text + " ] 为没有定义的物品名称,请重新输入。    ", vbInformation, "请在基础设置中先定义物品名称"
     txtProductName.Text = ""
     txtProductName.SetFocus
  End If

End Sub

Private Sub txtSellDate_Change()

  Call Valid_OK
      
  On Error Resume Next
  If TestDate(txtSellDate.Text) Then
     chkEndDate.Enabled = True
      If txtSellDateE.Text <> "____-__-__" Then
         chkEndDate.Visible = False
         Label1(5).Visible = True
         txtSellDateE.Visible = True
         cmdSelectDateE.Visible = True
         Label1(5).Enabled = True
         txtSellDateE.Enabled = True
         cmdSelectDateE.Enabled = True
         cmbBranchName.SetFocus
         Exit Sub
      End If
     chkEndDate.SetFocus
    Else
     chkEndDate.Enabled = False
     Label1(5).Visible = False
     txtSellDateE.Visible = False
     cmdSelectDateE.Visible = False
     Label1(5).Enabled = False
     txtSellDateE.Enabled = False
     cmdSelectDateE.Enabled = False
  End If
 
End Sub

Private Sub txtSellDate_GotFocus()

 Call GoFocus(txtSellDate)
  
End Sub

Private Sub txtSellDate_KeyDown(KeyCode As Integer, Shift As Integer)

    Call MoveToNext(KeyCode)
  
End Sub

Private Sub txtSellDate_KeyPress(KeyAscii As Integer)

 If KeyAscii = 13 Then
    SendKeys "{tab}"
 End If
 
End Sub

Private Sub txtSellDate_LostFocus()

  On Error Resume Next
  
  '日期为空时退出
  If txtSellDate.Text = "____-__-__" Then Exit Sub
   
  If IsDate(txtSellDate.Text) = True Then
     chkEndDate.Enabled = True
     Exit Sub
   Else
     chkEndDate.Enabled = False
     MsgBox txtSellDate.Text + " 为错误的日期格式,请重新输入。    ", vbInformation, "例如：1999-09-19"
     txtSellDate.Text = "____-__-__"
     txtSellDate.SetFocus
  End If
  
End Sub

Private Function LostControl(SRecordset As String, SField As String, sValue As String) As Boolean

   Dim DB As Database, EF As Recordset, tmpStr As String
       tmpStr = "Select * From " & SRecordset & " Where " & SField & "='" & sValue & "'"
       
       On Error Resume Next

  Set DB = OpenDatabase(ConData, False, False, Constr)
       Set EF = DB.OpenRecordset(tmpStr, dbOpenDynaset)
           
         If EF.EOF And EF.BOF Then
            LostControl = False
         Else
            LostControl = True
         End If
         
       EF.Close
       DB.Close
   
End Function

Private Sub Valid_OK()
   
   If txtSellDate.Text <> "____-__-__" Or cmbBranchName.Text <> "" Or txtProductName.Text <> "" _
      Or txtNO <> "" Or cmbStyle.Text <> "" Then
      cmdOK.Enabled = True
   Else
      cmdOK.Enabled = False
   End If
   
End Sub

Private Sub GoFocus(CGF As Control)

   CGF.SelStart = 0
   CGF.SelLength = Len(CGF.Text)
   
End Sub

Private Sub MoveToNext(KS As Integer)
 
 If KS = 39 Then
    SendKeys "{tab}"
 End If
 
End Sub

Private Sub txtSellDateE_Change()

  Call Valid_OK
  
  If TestDate(txtSellDateE.Text) Then
     If cmbBranchName.Enabled = True Then
        cmbBranchName.SetFocus
     End If
  End If

End Sub

Private Sub txtSellDateE_GotFocus()

 Call GoFocus(txtSellDateE)

End Sub

Private Sub txtSellDateE_KeyDown(KeyCode As Integer, Shift As Integer)

     Call MoveToNext(KeyCode)
  
End Sub

Private Sub txtSellDateE_KeyPress(KeyAscii As Integer)

 If KeyAscii = 13 Then
    SendKeys "{tab}"
 End If
 
End Sub

Private Sub txtSellDateE_LostFocus()

  On Error Resume Next
  
  '日期为空时退出
  If txtSellDateE.Text = "____-__-__" Then Exit Sub
  
  If IsDate(txtSellDateE.Text) Then
     If cmbBranchName.Enabled = True Then
        cmbBranchName.SetFocus
     End If
     Exit Sub
   Else
     MsgBox txtSellDateE.Text + " 为错误的日期格式,请重新输入。    ", vbInformation, "例如：1999-09-19"
     txtSellDateE.Text = "____-__-__"
     txtSellDateE.SetFocus
  End If

End Sub

Private Function TestDate(strDate As String) As Boolean

  If IsDate(strDate) = True Then
     TestDate = True
    Else
     TestDate = False
  End If
  
End Function