📄 frm_dcdj.frm
字号:
VERSION 5.00
Begin VB.Form frm_dcdj
BackColor = &H0080C0FF&
BorderStyle = 3 'Fixed Dialog
Caption = "单次登记"
ClientHeight = 2364
ClientLeft = 2760
ClientTop = 3756
ClientWidth = 6708
Icon = "frm_dcdj.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2364
ScaleWidth = 6708
ShowInTaskbar = 0 'False
Begin VB.TextBox Text3
BackColor = &H00C0E0FF&
Height = 285
Left = 3324
MaxLength = 4
TabIndex = 2
Text = "0"
Top = 821
Width = 1968
End
Begin VB.TextBox Text2
BackColor = &H00C0E0FF&
Height = 285
IMEMode = 3 'DISABLE
Left = 3324
MaxLength = 8
PasswordChar = "*"
TabIndex = 6
Top = 1560
Width = 1968
End
Begin VB.CommandButton Command1
BackColor = &H00C0E0FF&
Cancel = -1 'True
Height = 390
Index = 1
Left = 5376
MaskColor = &H00FFFFFF&
Picture = "frm_dcdj.frx":000C
Style = 1 'Graphical
TabIndex = 8
Top = 555
UseMaskColor = -1 'True
Width = 1185
End
Begin VB.CommandButton Command1
BackColor = &H00C0E0FF&
Default = -1 'True
Height = 390
Index = 0
Left = 5376
MaskColor = &H00FFFFFF&
Picture = "frm_dcdj.frx":0FC6
Style = 1 'Graphical
TabIndex = 7
Top = 120
UseMaskColor = -1 'True
Width = 1185
End
Begin VB.ComboBox Combo1
BackColor = &H00C0E0FF&
Height = 276
Index = 3
ItemData = "frm_dcdj.frx":2724
Left = 3324
List = "frm_dcdj.frx":272E
Style = 2 'Dropdown List
TabIndex = 4
Top = 1195
Width = 1968
End
Begin VB.ComboBox Combo1
BackColor = &H00C0E0FF&
Height = 276
Index = 2
Left = 960
TabIndex = 3
Text = "Combo1"
Top = 1188
Width = 1455
End
Begin VB.TextBox Text1
BackColor = &H00C0E0FF&
Enabled = 0 'False
Height = 285
Left = 960
MaxLength = 4
TabIndex = 5
Top = 1572
Width = 1455
End
Begin VB.ComboBox Combo1
BackColor = &H00C0E0FF&
Height = 276
Index = 1
Left = 3324
TabIndex = 1
Text = "Combo1"
Top = 456
Width = 1968
End
Begin VB.ComboBox Combo1
BackColor = &H00C0E0FF&
Height = 276
Index = 0
Left = 960
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 0
Top = 450
Width = 1455
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "费用调整："
Height = 180
Index = 9
Left = 2436
TabIndex = 21
Top = 888
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "日期："
Height = 180
Index = 2
Left = 2712
TabIndex = 20
Top = 1956
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "项目："
Height = 180
Index = 4
Left = 2796
TabIndex = 19
Top = 540
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "美发："
Height = 180
Index = 6
Left = 2784
TabIndex = 18
Top = 1272
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户密码："
Height = 180
Index = 8
Left = 2460
TabIndex = 17
Top = 1608
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label2"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 228
Index = 2
Left = 3312
TabIndex = 16
Top = 1920
Width = 576
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label2"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 225
Index = 1
Left = 3405
TabIndex = 15
Top = 135
Width = 570
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label2"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 225
Index = 0
Left = 1050
TabIndex = 14
Top = 165
Width = 570
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户签名："
Height = 180
Index = 7
Left = 12
TabIndex = 13
Top = 1620
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "赠送："
Height = 180
Index = 5
Left = 372
TabIndex = 12
Top = 1272
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "美容师："
Height = 180
Index = 3
Left = 285
TabIndex = 11
Top = 510
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "次数："
Height = 180
Index = 1
Left = 2880
TabIndex = 10
Top = 168
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "编号："
Height = 180
Index = 0
Left = 465
TabIndex = 9
Top = 195
Width = 540
End
End
Attribute VB_Name = "frm_dcdj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rec As Recordset
Dim itmx As ListItem
Private Sub OKButton_Click()
End Sub
Private Sub Command1_Click(Index As Integer)
On Error GoTo jgqerr
If Index = 0 Then
If Trim(Combo1(1).Text) = "" Then
MsgBox "项目不能为空，请输入", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
If Trim(Text2) = "" Then
MsgBox "请输入用户密码", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
If IsNumeric(Text3) = False Then
MsgBox "输入的费用调整不为数字", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
Select Case jjj
Case 0
sqlstr = "select * from 包月卡 where 类型='包月卡' and 编号=" + Label2(0) + " and 姓名='" + Text1 + "' and 密码='" + Text2 + "'"
Case 1
sqlstr = "select * from 包月卡 where 类型='疗程卡' and 编号=" + Label2(0) + " and 姓名='" + Text1 + "' and 密码='" + Text2 + "'"
Case 2
sqlstr = "select * from 包月卡 where 类型='美发包月卡' and 编号=" + Label2(0) + " and 姓名='" + Text1 + "' and 密码='" + Text2 + "'"
End Select
Set rec = db.OpenRecordset(sqlstr)
If rec.EOF And rec.BOF Then
MsgBox "密码输入错误", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
If Val(Text3) <> 0 Then
frm_bykgl.Text1(2) = Val(frm_bykgl.Text1(2)) + Val(Text3)
rec.Edit
rec.Fields("金额") = Val(frm_bykgl.Text1(2))
rec.Update
End If
Set rec = db.OpenRecordset("包月明细卡")
rec.AddNew
rec.Fields("编号") = Val(Label2(0))
rec.Fields("次数") = Val(Label2(1))
rec.Fields("日期") = Date
rec.Fields("美容师") = Combo1(0).Text
rec.Fields("项目") = Combo1(1).Text
If jjj = 0 Then
rec.Fields("赠送") = Combo1(2).Text
rec.Fields("美发") = Combo1(3).Text
End If
rec.Fields("备注") = Text1
Select Case jjj
Case 0
rec.Fields("类型") = "包月卡"
rec.Fields("金额") = Round(Val(frm_bykgl.Text1(2)) / 4)
Case 1
rec.Fields("类型") = "疗程卡"
rec.Fields("金额") = Round(Val(frm_bykgl.Text1(2)) / 5)
Case 2
rec.Fields("类型") = "美发包月卡"
rec.Fields("金额") = Round(Val(frm_bykgl.Text1(2)) / 4)
End Select
rec.Update
Set itmx = frm_bykgl.ListView1.ListItems.Add(, , Label2(1))
itmx.SubItems(1) = Label2(2)
itmx.SubItems(2) = Combo1(0).Text
itmx.SubItems(3) = Combo1(1).Text
If jjj = 0 Then
itmx.SubItems(4) = Combo1(2).Text
itmx.SubItems(5) = Combo1(3).Text
itmx.SubItems(6) = Text1
itmx.SubItems(7) = "否"
Else
itmx.SubItems(4) = Text1
itmx.SubItems(5) = "否"
End If
Else
End If
Unload Me
'frm_bykgl.Show
Exit Sub
jgqerr:
MsgBox Err.Description, vbOKOnly + vbCritical, "错误"
End Sub
Private Sub Form_Load()
'Set db = OpenDatabase(AppPath + "datas\mry.mdb")
Set rec = db.OpenRecordset("美容师人员表")
Do While Not rec.EOF
Combo1(0).AddItem rec.Fields("姓名")
rec.MoveNext
Loop
If Combo1(0).ListCount = 0 Then
Command1(0).Enabled = False
Else
Combo1(0).ListIndex = 0
End If
Label2(0) = frm_bykgl.Text1(0)
Label2(1) = frm_bykgl.ListView1.ListItems.Count + 1
Label2(2) = Format(Date, "yyyy-mm-dd")
note = Split(frm_bykgl.Text1(3), "，")
For i = 0 To UBound(note)
Combo1(1).AddItem note(i)
Next i
Set rec = db.OpenRecordset("项目收费表")
Do While Not rec.EOF
Combo1(1).AddItem rec.Fields("项目")
rec.MoveNext
Loop
If Combo1(1).ListCount = 0 Then
Command1(0).Enabled = False
Else
Combo1(1).ListIndex = 0
End If
If jjj = 0 Then
Select Case Label2(1).Caption
Case "1"
sqlstr = "select 项目 from 包月优惠表 where 时间='第一次'"
Case "2"
sqlstr = "select 项目 from 包月优惠表 where 时间='第二次'"
Case "3"
sqlstr = "select 项目 from 包月优惠表 where 时间='第三次'"
Case "4"
sqlstr = "select 项目 from 包月优惠表 where 时间='第四次'"
Case "5"
sqlstr = "select 项目 from 包月优惠表 where 时间=第五次'"
End Select
Set rec = db.OpenRecordset(sqlstr)
Combo1(2).Clear
Do While Not rec.EOF
Combo1(2).AddItem rec.Fields("项目")
rec.MoveNext
Loop
If Combo1(2).ListCount = 0 Then
Else
Combo1(2).ListIndex = 0
End If
Else '非包月卡
Label1(5).Visible = False
Label1(6).Visible = False
Combo1(2).Visible = False
Combo1(3).Visible = False
End If
Text1 = frm_bykgl.Text1(1)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'db.Close
'Set db = Nothing
End Sub
Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -