📄 frmexitcard.frm
字号:
VERSION 5.00
Begin VB.Form frmExitCard
BorderStyle = 3 'Fixed Dialog
Caption = "退卡"
ClientHeight = 3930
ClientLeft = 45
ClientTop = 330
ClientWidth = 3660
Icon = "frmExitCard.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3930
ScaleWidth = 3660
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdFind
Caption = "查 询"
Height = 375
Left = 1680
TabIndex = 3
Top = 3360
Width = 855
End
Begin VB.CommandButton cmdExit
Caption = "退 出"
Height = 375
Left = 2640
TabIndex = 2
Top = 3360
Width = 855
End
Begin VB.CommandButton cmdExitCard
Caption = "退 卡"
Height = 375
Left = 720
TabIndex = 1
Top = 3360
Width = 855
End
Begin VB.Frame fraExitCard
Caption = "退卡"
Height = 3015
Left = 240
TabIndex = 0
Top = 120
Width = 3255
Begin VB.CommandButton cmdList
Caption = "..."
Height = 300
Left = 2520
TabIndex = 6
Top = 360
Width = 495
End
Begin VB.TextBox txtC_ID
Height = 270
Left = 1320
MaxLength = 10
TabIndex = 5
Top = 360
Width = 1215
End
Begin VB.TextBox txtCH_Memo
Height = 990
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 4
Top = 1800
Width = 2895
End
Begin VB.Label lblMoneyTT
AutoSize = -1 'True
Height = 180
Left = 1440
TabIndex = 12
Top = 1200
Width = 90
End
Begin VB.Label lblMoneySS
AutoSize = -1 'True
Caption = "剩余金额："
Height = 180
Left = 240
TabIndex = 11
Top = 1200
Width = 900
End
Begin VB.Label lblCH_nameList
AutoSize = -1 'True
Height = 180
Left = 1440
TabIndex = 10
Top = 840
Width = 90
End
Begin VB.Label lblCH_name
AutoSize = -1 'True
Caption = "持卡人姓名："
Height = 180
Left = 240
TabIndex = 9
Top = 840
Width = 1080
End
Begin VB.Label LblC_ID
AutoSize = -1 'True
Caption = "持卡人ID："
Height = 180
Left = 240
TabIndex = 8
Top = 405
Width = 900
End
Begin VB.Label lblCH_Memo
AutoSize = -1 'True
Caption = "持卡人描述："
Height = 180
Left = 240
TabIndex = 7
Top = 1560
Width = 1080
End
End
End
Attribute VB_Name = "frmExitCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' ''
''Filename frmExitCard.frm ''
'' ''
''Created On 2004.3.6--2004.3.8 ''
'' ''
''Description 退卡窗体 ''
'' ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim RsCardholder As Recordset
Dim rsExitCard As Recordset
Dim rsExitCardfIND As Recordset
Dim rsSaving As Recordset
Dim rsStopUseFind As Recordset
Dim rsLossFind As Recordset
Dim rsShangJi As Recordset
Dim rsUser As Recordset
Dim rsOperateLog As Recordset
Dim rsLog As Recordset
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdExitCard_Click()
If Judge = True Then
If MsgBox("确实要退卡吗?退卡后将删除您的所有信息!", vbYesNo + vbQuestion, "机房管理") = vbYes Then
SaveInfo
lblCH_nameList.Caption = ""
lblMoneyTT.Caption = ""
txtCH_Memo.Text = ""
End If
End If
End Sub
Private Sub cmdFind_Click()
frmExitCardFind.Show 1 '打开查询窗体
Call AddLog("L19", "Find")
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''显示持卡人窗体，供用户选择持卡人 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdList_Click()
frmCardholderList.StrForm = "frmExitCard"
frmCardholderList.Show 1
txtC_ID.SetFocus
End Sub
Private Sub Form_Load()
txtCH_Memo.Enabled = False
End Sub
Private Sub txtC_ID_Change()
txtC_ID.Text = Left(txtC_ID.Text, 1) & UCase(Mid(txtC_ID.Text, 2, 1)) & Right(txtC_ID.Text, 8)
Set RsCardholder = New Recordset
RsCardholder.Open "select * from TbCardholder where ch_ID like '" & txtC_ID.Text & "'", Modmain.conn, 3, 2
lblCH_nameList.Caption = RsCardholder.Fields!CH_Name
lblMoneyTT.Caption = RsCardholder.Fields!Money
If RsCardholder.Fields!CH_Memo <> "" Then
txtCH_Memo.Text = RsCardholder.Fields!CH_Memo
End If
If RsCardholder.RecordCount = 0 Then
MsgBox "您输入的卡号不存在，请确认后重新输入", vbOKOnly + vbExclamation, "机房管理"
txtC_ID.Text = ""
txtC_ID.SetFocus
End If
SendKeys "{tab}"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''输入或选择持卡人后，显示其简单信息 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub txtC_ID_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or Len(txtC_ID.Text) = 10 Then
txtC_ID.Text = Left(txtC_ID.Text, 1) & UCase(Mid(txtC_ID.Text, 2, 1)) & Right(txtC_ID.Text, 8)
Set RsCardholder = New Recordset
RsCardholder.Open "select * from TbCardholder where ch_ID like '" & txtC_ID.Text & "'", Modmain.conn, 3, 2
lblCH_nameList.Caption = RsCardholder.Fields!CH_Name
lblMoneyTT.Caption = RsCardholder.Fields!Money
If RsCardholder.Fields!CH_Memo <> "" Then
txtCH_Memo.Text = RsCardholder.Fields!CH_Memo
End If
If RsCardholder.RecordCount = 0 Then
MsgBox "您输入的卡号不存在，请确认后重新输入", vbOKOnly + vbExclamation, "机房管理"
txtC_ID.Text = ""
txtC_ID.SetFocus
End If
SendKeys "{tab}"
End If
End Sub
Private Function Judge() As Boolean
If Trim(txtC_ID) = "" Then
MsgBox "持卡人ID不能为空", vbOKOnly + vbExclamation, "机房管理"
txtC_ID.SetFocus
Else
Judge = True
End If
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''保存退卡的简单信息，并删除该退卡人的所有信息 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub SaveInfo()
Set rsExitCard = New Recordset
rsExitCard.Open "select * from TbExitCard", Modmain.conn, 3, 2
With rsExitCard
.AddNew
.Fields!C_ID = txtC_ID.Text
.Fields!Date = Date
.Fields!U_ID = frmLoad.StrU_ID
.Update
DeleteAllInfo '删除该退卡人的所有信息
Call AddLog("L18", "Exit")
MsgBox "退卡成功！", vbDefaultButton1, "机房管理"
End With
End Sub
Private Sub DeleteAllInfo()
Set rsSaving = New Recordset
rsSaving.Open "select * from TbSaving where C_ID like '" & txtC_ID.Text & "' ", Modmain.conn, 3, 2
If rsSaving.RecordCount <> 0 Then '删除TbSaving信息
While Not rsSaving.EOF
rsSaving.Delete
rsSaving.MoveNext
Wend
End If
Set rsStopUseFind = New Recordset
rsStopUseFind.Open "select * from TbStopUse where C_ID like '" & txtC_ID.Text & "' ", Modmain.conn, 3, 2
If rsStopUseFind.RecordCount <> 0 Then '删除TbStopUse 信息
While Not rsStopUseFind.EOF
rsStopUseFind.Delete
rsStopUseFind.MoveNext
Wend
End If
Set rsLossFind = New Recordset
rsLossFind.Open "select * from TbLoss where C_ID like '" & txtC_ID.Text & "' ", Modmain.conn, 3, 2
If rsLossFind.RecordCount <> 0 Then '删除TbLoss 信息
While Not rsLossFind.EOF
rsLossFind.Delete
rsLossFind.MoveNext
Wend
End If
Set rsShangJi = New Recordset
rsShangJi.Open "select * from TbShangji where C_ID like '" & txtC_ID.Text & "' ", Modmain.conn, 3, 2
If rsShangJi.RecordCount <> 0 Then ' 删除TbShangji 信息
While Not rsShangJi.EOF
rsShangJi.Delete
rsShangJi.MoveNext
Wend
End If
RsCardholder.Delete '删除tbCardholder信息
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''将用户退卡、查询退卡的信息记入操作日志 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub AddLog(aa As String, bb As String)
Dim strEvents As String
Dim strTemp As String
strTemp = "'"
Set rsOperateLog = New Recordset
rsOperateLog.Open "select * from tbOperateLog", Modmain.conn, 3, 2
Set rsLog = New Recordset
rsLog.Open "select * from tblog where L_ID='" & aa & "'", Modmain.conn, 3, 2
strEvents = rsLog.Fields!Events
rsOperateLog.AddNew
rsOperateLog.Fields!U_ID = frmLoad.StrU_ID
rsOperateLog.Fields!Time = Time
rsOperateLog.Fields!Date = Date
rsOperateLog.Fields!Events = strEvents
If bb = "Exit" Then
rsOperateLog.Fields!Description = strEvents & strTemp & txtC_ID.Text & strTemp
ElseIf bb = "Find" Then
rsOperateLog.Fields!Description = strEvents
End If
rsOperateLog.Update
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -