frm_bykgl.frm

美容院管理系统

       yn = MsgBox("可能已经过期（一个月），建议您不要再登记" + Chr(13) + "真的要登记吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示")
       If yn = vbNo Then
            Exit Sub
       End If
    End If
If ListView1.ListItems.Count >= 5 Then
        yn = MsgBox("该用户已经登记了 " & ListView1.ListItems.Count & " 次" + Chr(13) + "建议您不要在登记，真的要登记吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示")
        If yn = vbNo Then
            Exit Sub
        End If
    End If
Case 2
If Date - CDate(Text1(4)) > 90 Then
       yn = MsgBox("可能已经过期（三个月），建议您不要再登记" + Chr(13) + "真的要登记吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示")
       If yn = vbNo Then
            Exit Sub
       End If
    End If
If ListView1.ListItems.Count >= 4 Then
        yn = MsgBox("该用户已经登记了 " & ListView1.ListItems.Count & " 次" + Chr(13) + "建议您不要在登记，真的要登记吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示")
        If yn = vbNo Then
            Exit Sub
        End If
    End If
End Select
'Me.Hide
frm_dcdj.Show 1
Case 7 '删除单次登记
yn = MsgBox("真的想删除第 " + ListView1.SelectedItem.Text + " 次美容登记吗？", vbYesNo + vbQuestion, "提示")
If yn = vbNo Then
    Exit Sub
End If
    
    sqlstr = "delete * from 包月明细卡 where 类型='" + kl + "' and 编号=" + Text1(0) + " and 次数=" + ListView1.SelectedItem.Text
    db.Execute sqlstr
    ListView1.ListItems.Remove ListView1.ListItems.Count
    Command1(6).Enabled = True
Case 8
    Unload Me
Case 12 '确定

If Check2.Value Then
    If Trim(Text2(0)) = "" Then
        sqlstr = "select * from 包月卡 where 姓名 like '*" + Trim(Text2(1)) + "*' and 诊断 like '*" + Trim(Text2(2)) + "*' and 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "#"
    Else
        sqlstr = "select * from 包月卡 where 姓名 like '*" + Trim(Text2(1)) + "*' and 诊断 like '*" + Trim(Text2(2)) + "*' and 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# and 编号=" + Trim(Text2(0)) + ""
    End If
    
Else
    If Trim(Text2(0)) = "" Then
        sqlstr = "select * from 包月卡 where 姓名 like '*" + Trim(Text2(1)) + "*' and 诊断 like '*" + Trim(Text2(2)) + "*'"
    Else
        sqlstr = "select * from 包月卡 where 姓名 like '*" + Trim(Text2(1)) + "*' and 诊断 like '*" + Trim(Text2(2)) + "*' and 编号=" + Trim(Text2(0)) + ""
    End If
End If
Set sqlrec = db.OpenRecordset(sqlstr)
If sqlrec.EOF And sqlrec.BOF Then
    yn = MsgBox("没有您要查找的记录，还要继续查找吗？", vbYesNo + vbInformation, "提示")
    If yn = vbNo Then
        disa
    Else
        Text2(0).SetFocus
    End If
Else
   sqlrec.MoveLast
   sqlrec.MoveFirst
   If sqlrec.RecordCount = 1 Then
   Else
      MsgBox "查到您要找的记录 " & sqlrec.RecordCount & " 条，下面只能列出第一条" + Chr(13) + "您可以重设查询条件再查找", vbOKOnly + vbInformation, "提示"
   End If
    disa
      tr
      For i = 0 To List1.ListCount - 1
            If List1.List(i) = Text1(3) Then
                List1.ListIndex = i
                Exit For
            End If
      Next i
      For i = 0 To List2.ListCount - 1
                If Val(List2.List(i)) = Val(Text1(0)) Then
                List2.ListIndex = i
                Exit For
            End If
      Next i
      
End If

Case 11 '取消
    disa
End Select
Exit Sub
jgqerr:
    MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
End Sub

Private Sub Form_Load()
DTPicker1(0).Value = Date - 30
DTPicker1(1).Value = Date
Select Case jjj
Case 0
    kl = "包月卡"
    Label3 = "注：三个月内有效"
'    frm_main.Toolbar2.Buttons(4).Enabled = False
    frm_main.byk.Enabled = False
Case 1
    kl = "疗程卡"
    Label3 = "注：一个月内有效"
    frm_main.lck.Enabled = False
Case 2
    kl = "美发包月卡"
    Label3 = "注：三个月内有效"
    frm_main.mfbyk.Enabled = False
End Select
Me.Caption = kl + "管理"
frmcen Me
'Set db = OpenDatabase(AppPath + "\datas\mry.mdb")
Set db = OpenDatabase(AppPath + "datas\mry.mdb", True, False, ";PWD=miracle")


ListView1.ColumnHeaders.Clear
If kl = "包月卡" Then
    Set con = ListView1.ColumnHeaders.Add(, , "次数", 600)
    Set con = ListView1.ColumnHeaders.Add(, , "日期", 1100, 2)
    Set con = ListView1.ColumnHeaders.Add(, , "美容师", 1000, 0)
    Set con = ListView1.ColumnHeaders.Add(, , "项目", 1440, 0)
    Set con = ListView1.ColumnHeaders.Add(, , "赠送", 700, 2)
    Set con = ListView1.ColumnHeaders.Add(, , "美发", 700, 2)
    Set con = ListView1.ColumnHeaders.Add(, , "备注", 1200, 0)
    Set con = ListView1.ColumnHeaders.Add(, , "原料支配", 1000, 2)
    
Else
 Set con = ListView1.ColumnHeaders.Add(, , "次数", 600)
    Set con = ListView1.ColumnHeaders.Add(, , "日期", 1100, 2)
    Set con = ListView1.ColumnHeaders.Add(, , "美容师", 1000, 0)
    Set con = ListView1.ColumnHeaders.Add(, , "项目", 1440, 0)
    Set con = ListView1.ColumnHeaders.Add(, , "备注", 1200, 0)
    Set con = ListView1.ColumnHeaders.Add(, , "原料支配", 1000, 2)
End If
ss
disa
End Sub

Private Sub Form_Unload(Cancel As Integer)
'frm_main.Toolbar2.Buttons(4).Enabled = True
frm_main.lck.Enabled = True
frm_main.byk.Enabled = True
frm_main.mfbyk.Enabled = True
    SaveSetting App.title, "Options", "byk_maxno", byk_maxno
    SaveSetting App.title, "Options", "lck_maxno", lck_maxno
    SaveSetting App.title, "Options", "mfbyk_maxno", mfbyk_maxno

End Sub
Private Sub ss()
sqlstr = "select DISTINCT 诊断 from 包月卡 where 类型='" + kl + "'"
Set sqlrec = db.OpenRecordset(sqlstr)
List1.Clear
Do While Not sqlrec.EOF
    List1.AddItem sqlrec.Fields("诊断")
    sqlrec.MoveNext
Loop
If List1.ListCount = 0 Then
   For i = 0 To 8
        Command1(i).Enabled = False
   Next i
   Command1(0).Enabled = True
   Command1(8).Enabled = True
   For i = 0 To Text1.Count - 1
        Text1(i) = ""
   Next i
   ListView1.ListItems.Clear
   List2.Clear
Else
    List1.ListIndex = 0
     For i = 0 To 8
        Command1(i).Enabled = True
   Next i
     Command1(7).Enabled = False
End If
End Sub
Private Sub disa()
Frame2.Visible = False
Frame1.Visible = True
List1.Enabled = True
List2.Enabled = True
Picture1.Visible = True
Picture2.Visible = False
Command1(6).Default = True
Command1(8).Cancel = True
End Sub
Private Sub enab()
Command1(12).Default = True
Command1(11).Cancel = True
Frame2.Visible = True
Frame1.Visible = False
List1.Enabled = False
List2.Enabled = False
Picture1.Visible = False
Picture2.Visible = True
Text2(0).SetFocus
End Sub

Private Sub List1_Click()
On Error GoTo myerr
sqlstr = "select * from 包月卡 where 类型='" + kl + " ' and 诊断='" + List1.Text + "'"
Set sqlrec = db.OpenRecordset(sqlstr)
Select Case jjj
Case 0
   kg = Len(byk_maxno)
Case 1
    kg = Len(lck_maxno)
Case 2
    kg = Len(mfbyk_maxno)
End Select
List2.Clear
Do While Not sqlrec.EOF
'    kgb = kg - Len(Trim(Str(sqlrec.Fields("编号"))))
    List2.AddItem sqlrec.Fields("编号") & "-" & sqlrec.Fields("姓名")
    sqlrec.MoveNext
Loop
If List2.ListCount = 0 Then
   For i = 0 To 8
        Command1(i).Enabled = False
   Next i
   Command1(0).Enabled = True
   Command1(8).Enabled = True
Else
    List2.ListIndex = 0
  
     For i = 0 To 8
        Command1(i).Enabled = True
   Next i
  Command1(7).Enabled = False
End If
disa
Exit Sub
myerr:
    MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
End Sub
Private Sub tr()
Text1(0) = sqlrec.Fields("编号")
Text1(1) = sqlrec.Fields("姓名")
Text1(2) = sqlrec.Fields("金额")
Text1(3) = sqlrec.Fields("诊断")
Text1(4) = Format(sqlrec.Fields("日期"), "yyyy-mm-dd")
Text1(5) = IIf(IsNull(sqlrec.Fields("备注")), "", sqlrec.Fields("备注"))
Check1.Value = IIf(sqlrec.Fields("是否包全年") = "是", 1, 0)


End Sub

Private Sub List2_Click()

On Error GoTo jjjerr
sqlstr = "select * from 包月卡 where 类型='" + kl + " ' and 编号=" + Trim(Str(Val(List2.Text))) + ""
Set sqlrec = db.OpenRecordset(sqlstr)
    ListView1.ListItems.Clear
If sqlrec.EOF And sqlrec.BOF Then
   Command1(7).Enabled = False
Else
    tr
    sqlstr = "select * from 包月明细卡 where 编号=" + Trim(Str(Val(List2.Text))) + " and 类型='" + kl + "'"
    Set childrec = db.OpenRecordset(sqlstr)
    
        Do While Not childrec.EOF
               
               Set itmx = ListView1.ListItems.Add(, , childrec.Fields("次数"))
                
                   itmx.SubItems(1) = Format(childrec.Fields("日期"), "yyyy-mm-dd")
                   itmx.SubItems(2) = IIf(IsNull(childrec.Fields("美容师")), "", childrec.Fields("美容师"))
                   itmx.SubItems(3) = IIf(IsNull(childrec.Fields("项目")), "", childrec.Fields("项目"))
               If ListView1.ColumnHeaders.Count = 8 Then
                   itmx.SubItems(4) = IIf(IsNull(childrec.Fields("赠送")), "", childrec.Fields("赠送"))
                   itmx.SubItems(5) = IIf(IsNull(childrec.Fields("美发")), "", childrec.Fields("美发"))
                   itmx.SubItems(6) = IIf(IsNull(childrec.Fields("备注")), "", childrec.Fields("备注"))
                   itmx.SubItems(7) = childrec.Fields("原料支配")
                Else
                       itmx.SubItems(4) = IIf(IsNull(childrec.Fields("备注")), "", childrec.Fields("备注"))
                   itmx.SubItems(5) = childrec.Fields("原料支配")
                End If
                   childrec.MoveNext
    Loop
             Select Case jjj
       Case 0
            If ListView1.ListItems.Count >= 4 Then
                'Command1(6).Enabled = False
            Else
                Command1(6).Enabled = True
            End If
       Case 1
       If ListView1.ListItems.Count >= 5 Then
                'Command1(6).Enabled = False
            Else
                Command1(6).Enabled = True
            End If
       Case 2
       If ListView1.ListItems.Count >= 4 Then
                'Command1(6).Enabled = False
            Else
                Command1(6).Enabled = True
            End If
       End Select
End If
Exit Sub
jjjerr:
    MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
If Item.Text = ListView1.ListItems.Count Then
   Command1(7).Enabled = True
Else
    Command1(7).Enabled = False
End If
End Sub

Private Sub Text2_GotFocus(Index As Integer)
Text2(Index).SelStart = 0
Text2(Index).SelLength = Len(Text2(Index))
If Index = 0 Then
   ' Text2(Index).IMEMode = 2
Else
   ' Text2(Index).IMEMode = 1
End If
End Sub

Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 0 Then
    Select Case KeyAscii
    Case 59, 63, 13
        KeyAscii = 0
    End Select
    
End If
End Sub

Private Sub Text2_LostFocus(Index As Integer)
If Len(Text2(0)) = 10 Then
    Text2(0) = Mid(Text2(0), 2, 8)
End If
End Sub