📄 scgl_dfdw.frm
字号:
End
Begin VB.Label frm_msg
Alignment = 1 'Right Justify
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 570
Left = 7080
TabIndex = 23
Top = 0
Visible = 0 'False
Width = 4365
End
End
Attribute VB_Name = "scgL_dfdw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim key_index As Integer
Dim t_bt As String
Dim t_fields As Variant
Dim response As String
Dim t_rec As Recordset 'MSFLEXGRID
Dim rec As Recordset
Dim rec1 As Recordset
Dim t_rec1 As Recordset
Dim t_rq As String
Dim dh As String
Dim date1 As Date
Dim date2 As Date
Dim TJ As String '筛选条件
Dim del_tf As Boolean
Private Sub Form_Load()
Me.KeyPreview = True
CENTER Me
TJ = ""
Set rec = PUB_data.OpenRecordset("SELECT ZH,Trim(KR_X)+Trim(KR_M),KR_XBMC,RZRQ,LDRQ,ZXFE,YWDW_MC,TDMC,LOCK_NO FROM DT_KRQD ", 2, 0, 2) 'ORDER BY ZH
If Not rec.BOF Then
rec.MoveLast
End If
t_bt = "客房房号 |^ 客 人 姓 名 |^ 性别 |^ 入住日期 |^ 离店日期 |^ 总消费额 |^ 订房单位 |^ 团队名称 "
t_fields = Array(0, 1, 2, 3, 4, 5, 6, 7)
Call pub_memo.Flex_full(FLEX1, t_bt, rec, t_fields, 7, Array(0, 0, 0, 0, 0, 0, 0, 0))
rec_num.Caption = "记录数:" + CStr(FLEX1.Rows - 1)
Call first
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
key_index = 100
frm_msg.Caption = ""
frm_msg.Visible = False
Select Case KeyCode
Case vbKeyF3
key_index = 0 '订房补记
Case vbKeyF6
key_index = 1 '筛选
Case vbKeyF9
key_index = 2 '刷新
Case vbKeyEscape
key_index = 99 '退出
End Select
Select Case key_index
Case 0, 1, 2
If Frame2.Enabled = False Then
Call Cmd2_Click(key_index)
End If
Case 99
If Frame2.Enabled = True Then
Call first
Else
Call CMD_EXIT_Click
End If
End Select
End Sub
Sub MAIN(t_gnmc As String)
Label1.Caption = t_gnmc
JZ_USER = SYS_USER + Space(1) + SYS_NAME
JZ_JRSJ2 = Time()
JZ_DQSJ2 = Time()
End Sub
Private Sub CMD_EXIT_Click()
Unload Me
yx_main.Show (1)
End Sub
Private Sub Cmd2_Click(Index As Integer)
Select Case Index
Case 0
scgl_dfdw_dm.Show (1)
If scgl_dfdw_dm.tf Then
Set rec = PUB_data.OpenRecordset("select KHDM,YWDW_MC,TDMC,CZY, LOCK_NO FROM DT_KRQD WHERE TRIM(ZH)='" & UCase(Trim(m_zh.Text)) & "'", 2, 0, 2)
If Not rec.BOF Then
rec.MoveLast
Dim JJ As Integer
JJ = rec.RecordCount
If Not Trim(rec!TDMC) = "*" Then
response = MsgBox("该客人属于团队" & UCase(Trim(rec!TDMC)) & ",是否修改该团队所有订房单位?", 1)
If response = 1 Then
Set rec1 = PUB_data.OpenRecordset("SELECT KHDM,YWDW_MC,CZY, LOCK_NO FROM DT_KRQD WHERE UCASE(TRIM(TDMC))='" & UCase(Trim(rec!TDMC)) & "'", 2, 0, 2)
If Not rec1.BOF Then
rec1.MoveLast
Do
Select Case Pub_lock("PUBLIC", "DT_KRQD", rec1)
Case "1"
Exit Do
Case "2"
Call Pub_UNlock("DT_KRQD", rec1)
End Select
Loop
rec1.MoveFirst
End If
Do Until rec1.EOF
With rec1
.Edit
!KHDM = scgl_dfdw_dm.kh_dm
!YWDW_MC = scgl_dfdw_dm.ywdw_m
!CZY = SYS_USER
.Update
End With
rec1.MoveNext
Loop
Call Pub_UNlock("DT_KRQD", rec1)
Call flex1_ref
Call first
Else
Do
Select Case Pub_lock("PUBLIC", "DT_KRQD", rec)
Case "1"
Exit Do
Case "2"
Call Pub_UNlock("DT_KRQD", rec)
Exit Sub
End Select
Loop
With rec
.Edit
!KHDM = scgl_dfdw_dm.kh_dm
!YWDW_MC = scgl_dfdw_dm.ywdw_m
!CZY = SYS_USER
.Update
End With
Call Pub_UNlock("DT_KRQD", rec)
Call flex1_ref
Call first
End If
Else
Do
Select Case Pub_lock("PUBLIC", "DT_KRQD", rec)
Case "1"
Exit Do
Case "2"
Call Pub_UNlock("DT_KRQD", rec)
Exit Sub
End Select
Loop
With rec
.Edit
!KHDM = scgl_dfdw_dm.kh_dm
!YWDW_MC = scgl_dfdw_dm.ywdw_m
!CZY = SYS_USER
.Update
End With
Call Pub_UNlock("DT_KRQD", rec)
Call flex1_ref
Call first
End If
End If
End If
Case 1
FLEX1.Enabled = False
Frame2.Enabled = True
m_zh1.SetFocus
m_zh1.SelStart = 0
m_zh1.SelLength = Len(Trim(m_zh.Text))
Case 2
Call flex1_ref
End Select
End Sub
Private Sub FLEX1_GotFocus()
On Error GoTo error1:
m_zh.Text = Trim(FLEX1.TextArray(FLEX1.Row * 8))
m_krxm.Text = Trim(FLEX1.TextArray(FLEX1.Row * 8 + 1))
Select Case FLEX1.TextArray(FLEX1.Row * 8 + 2)
Case "男"
OPT(0).Value = True
Case "女"
OPT(1).Value = True
Case "*"
OPT(2).Value = True
End Select
m_rzrq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 8 + 3)) = "", " - - ", Trim(FLEX1.TextArray(FLEX1.Row * 8 + 3)))
m_ldrq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 8 + 4)) = "", " - - ", Trim(FLEX1.TextArray(FLEX1.Row * 8 + 4)))
m_zxfe.Text = Trim(FLEX1.TextArray(FLEX1.Row * 8 + 5))
m_ywdw_mc.Text = Trim(FLEX1.TextArray(FLEX1.Row * 8 + 6))
Exit Sub
error1:
If Err() = 383 Then
Resume Next
End If
End Sub
Private Sub FLEX1_RowColChange()
On Error GoTo error1:
m_zh.Text = Trim(FLEX1.TextArray(FLEX1.Row * 8))
m_krxm.Text = Trim(FLEX1.TextArray(FLEX1.Row * 8 + 1))
Select Case FLEX1.TextArray(FLEX1.Row * 8 + 2)
Case "男"
OPT(0).Value = True
Case "女"
OPT(1).Value = True
Case "*"
OPT(2).Value = True
End Select
m_rzrq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 8 + 3)) = "", " - - ", Trim(FLEX1.TextArray(FLEX1.Row * 8 + 3)))
m_ldrq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 8 + 4)) = "", " - - ", Trim(FLEX1.TextArray(FLEX1.Row * 8 + 4)))
m_zxfe.Text = Trim(FLEX1.TextArray(FLEX1.Row * 8 + 5))
m_ywdw_mc.Text = Trim(FLEX1.TextArray(FLEX1.Row * 8 + 6))
Exit Sub
error1:
If Err() = 383 Then
Resume Next
End If
End Sub
Private Sub m_dfy_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
m_rzrq1.SetFocus
End If
End Sub
Private Sub m_rzrq1_Change()
frm_msg.Caption = ""
End Sub
Private Sub m_rzrq1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
m_rzrq2.SetFocus
End If
End Sub
Private Sub m_rzrq1_LostFocus()
If Not m_rzrq1.Text = " - - " Then
t_rq = date_cl(m_rzrq1.Text)
If Not t_rq = "F" Then
m_rzrq1 = t_rq
End If
If Not IsDate(m_rzrq.Text) Then
frm_msg.Caption = "无效日期!"
m_rzrq1.SetFocus
End If
End If
End Sub
Private Sub m_rzrq2_Change()
frm_msg.Caption = ""
End Sub
Private Sub m_rzrq2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If Not Trim(m_zh1.Text) = "" Then
TJ = "MID(Trim(ZH),1,4)='" & UCase(Trim(m_zh1.Text)) & "'"
Else
TJ = ""
End If
If Not Trim(m_dfy.Text) = "" Then
If Not TJ = "" Then
TJ = TJ & "AND TRIM(DFY_DM)='" & UCase(Trim(m_dfy.Text)) & "'"
Else
TJ = "TRIM(DFY_DM)='" & UCase(Trim(m_dfy.Text)) & "'"
End If
End If
If Not m_rzrq1.Text = " - - " Then
If Not TJ = "" Then
TJ = TJ & "AND CSTR(RZRQ)>='" & Format(CDate(m_rzrq1.Text), "yyyy-mm-dd") & "'"
Else
TJ = "CSTR(RZRQ)>='" & Format(CDate(m_rzrq1.Text), "yyyy-mm-dd") & "'"
End If
End If
If Not m_rzrq2.Text = " - - " Then
If Not TJ = "" Then
TJ = TJ & "AND CSTR(RZRQ)<='" & Format(CDate(m_rzrq2.Text), "yyyy-mm-dd") & "'"
Else
TJ = "CSTR(RZRQ)<='" & Format(CDate(m_rzrq2.Text), "yyyy-mm-dd") & "'"
End If
End If
If Not TJ = "" Then
Set rec = PUB_data.OpenRecordset("SELECT ZH,Trim(KR_X)+Trim(KR_M),KR_XBMC,RZRQ,LDRQ,ZXFE,YWDW_MC,TDMC,LOCK_NO FROM DT_KRQD WHERE " & TJ & " ORDER BY ZH", 4)
If Not rec.BOF Then
rec.MoveLast
Else
MsgBox "无符合筛选条件的记录!", 64
TJ = ""
Call flex1_ref
Call first
Exit Sub
End If
Else
Set rec = PUB_data.OpenRecordset("SELECT ZH,Trim(KR_X)+Trim(KR_M),KR_XBMC,RZRQ,LDRQ,ZXFE,YWDW_MC,TDMC,LOCK_NO FROM DT_KRQD ORDER BY ZH", 4)
If Not rec.BOF Then
rec.MoveLast
End If
End If
Call pub_memo.Flex_full(FLEX1, t_bt, rec, t_fields, 7, Array(0, 0, 0, 0, 0, 0, 0, 0))
rec_num.Caption = "记录数:" + CStr(FLEX1.Rows - 1)
Call first
End If
End Sub
Private Sub m_zh1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
m_dfy.SetFocus
m_dfy.SelStart = 0
m_dfy.SelLength = Len(Trim(m_dfy.Text))
End If
End Sub
Private Sub XT_Timer_Timer()
JZ_DQSJ2.Caption = Time()
End Sub
Private Sub flex1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Cmd2(0).SetFocus
End If
End Sub
Private Sub flex1_ref()
If TJ = "" Then
Set rec = PUB_data.OpenRecordset("SELECT ZH,Trim(KR_X)+Trim(KR_M),KR_XBMC,RZRQ,LDRQ,ZXFE,YWDW_MC,TDMC,LOCK_NO FROM DT_KRQD ORDER BY ZH", 4)
If Not rec.BOF Then
rec.MoveLast
End If
Else
Set rec = PUB_data.OpenRecordset("SELECT ZH,Trim(KR_X)+Trim(KR_M),KR_XBMC,RZRQ,LDRQ,ZXFE,YWDW_MC,TDMC,LOCK_NO FROM DT_KRQD WHERE " & TJ & " ORDER BY ZH", 4)
If Not rec.BOF Then
rec.MoveLast
End If
End If
Call pub_memo.Flex_full(FLEX1, t_bt, rec, t_fields, 7, Array(0, 0, 0, 0, 0, 0, 0, 0))
rec_num.Caption = "记录数:" + CStr(FLEX1.Rows - 1)
End Sub
Private Sub first()
If TJ = "" Then
m_zh1.Text = ""
m_rzrq1.Text = " - - "
m_rzrq2.Text = " - - "
m_dfy.Text = ""
End If
Cmd2(0).Enabled = True
Cmd2(1).Enabled = True
Cmd2(2).Enabled = True
Frame2.Enabled = False
Frame3.Enabled = False
If FLEX1.Enabled = False Then
FLEX1.Enabled = True
FLEX1.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -