frmmainsearchorder.frm

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

 
End Sub

Private Sub cmbStyle_LostFocus()

  If cmbStyle.Text = "" Then Exit Sub
  
  If Val(cmbStyle.Text) >= 0 And Val(cmbStyle.Text) <= 23 Then
     Exit Sub
   Else
     MsgBox "[ " + cmbStyle.Text + " ] 为无效的时间,请重新输入。    " & vbCrLf & vbCrLf & "    正确的时间是0-23之间的数字。   ", 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 SiteName='" & Trim(txtProductName.Text) & "'"
  End If
  
  '规格
  If cmbStyle.Text <> "" Then
     TmpStr = TmpStr + " And 时间=" & Trim(cmbStyle.Text)
  End If
    
 '付款类型
  If cmbPaymethod.Text <> "" Then
     TmpStr = TmpStr + " And 付款方式='" & Trim(cmbPaymethod.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

  ConfigPayMethod
  
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(1).Value) Then
               TmpStr = EF.Fields(1).Value
               cmbBranchName.AddItem TmpStr
            End If
            EF.MoveNext
         Loop
      End If
    EF.Close

  '检查座位分类
  Set EF = DB.OpenRecordset("SiteType", 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
               txtProductName.AddItem TmpStr
            End If
            EF.MoveNext
         Loop
      End If
    EF.Close
    
  '检查品名
  Dim X As Integer
  
   For X = 0 To 23
    cmbStyle.AddItem X
   Next
  
  DB.Close

End Sub

Private Sub txtProductName_Change()

  Call Valid_OK
  
End Sub

Private Sub txtProductName_Click()

  Call Valid_OK
  cmbStyle.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("SiteType", "SiteName", 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 <> "" Or cmbPaymethod.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

Private Sub ConfigPayMethod()

  Dim DB As Database, EF As Recordset, HH As Integer
  Set DB = OpenDatabase(ConData, False, False, Constr)
           
    Set EF = DB.OpenRecordset("Select * From PayType", dbOpenDynaset)
        HH = 1
        Do While Not EF.EOF()
          If Not IsNull(EF.Fields(1)) Then
             cmbPaymethod.AddItem EF.Fields(1).Value
          End If
          EF.MoveNext
          HH = HH + 1
        Loop
        
  EF.Close
  DB.Close
  
  If HH > 1 Then
     cmbPaymethod.ListIndex = GetSetting(App.EXEName, "Option", "PayMethod", 0)
     SaveSetting App.EXEName, "Option", "PayMethod", cmbPaymethod.ListIndex
  End If
 
End Sub