📄 cx_ydda.frm
字号:
Begin VB.Label Label1
BackColor = &H00C0C0C0&
BeginProperty Font
Name = "黑体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 0
TabIndex = 40
Top = 0
Width = 11775
End
Begin VB.Label frm_msg
BackColor = &H8000000A&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 735
Left = 5400
TabIndex = 39
Top = 0
Width = 6375
End
End
Attribute VB_Name = "cx_ydda"
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 t_rec As Recordset 'MSFLEXGRID
Dim t_rq As String
Dim T_TJ As String '筛选条件
Dim t_nam As String '归档表名
Dim response As String
Private Sub Form_Load()
Dim sys_uid As String, sys_pwd As String
JZ_USER = SYS_USER + Space(1) + SYS_NAME
JZ_JRSJ2 = Time()
sys_uid = "db2user"
sys_pwd = "db2user"
t_nam = "YD" & year(Format(Date, "yyyy-mm-dd"))
Set t_rec = PUB_data.OpenRecordset("select YDD_H,KR_MC,RZRQ,YDSJ,LDRQ,DF_JS,GZ_JS,RS,DFY_DM,KHDM,LOCK_NO from " & t_nam & "", 4)
If Not t_rec.BOF Then
t_rec.MoveLast
End If
name1.Caption = "预订档案一览表"
nam.Caption = ""
KeyPreview = True
Call first
t_fields = Array(0, 1, 2, 3, 4, 5, 6, 7, 8)
t_bt = "^ 预订单号 |^ 客人名称 |^预达日期 |^ 预达时间 |^预离日期 |^预订房数|^ 管制房数 |^人数|^订房员"
Call pub_memo.Flex_full(FLEX1, t_bt, t_rec, t_fields, 8, Array(0, 0, 0, 0, 0, 0, 0, 0, 0))
rec_no.Caption = "当前记录数:" + CStr(FLEX1.Rows - 1)
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 Cmd2_Click(Index As Integer)
Select Case Index
Case 0 '筛选
FLEX1.Enabled = False
nam.Caption = "当前操作:筛选"
Cmd2(0).Enabled = False
Cmd2(1).Enabled = False
Cmd2(2).Enabled = False
Frame3.Enabled = True
m_gdlx1.SetFocus
Case 1 '查询明细
FLEX1.Enabled = False
cx_ydda_yddh.m_ydd_h.Text = m_ydd_h.Text
cx_ydda_yddh.m_ydd_h.SelStart = 0
cx_ydda_yddh.m_ydd_h.SelLength = Len(Trim(cx_ydda_yddh.m_ydd_h.Text))
cx_ydda_yddh.Show (1)
If cx_ydda_yddh.tf Then
cx_ydda_mx.Show (1)
Call refresh1
Call first
Else
Call first
Exit Sub
End If
Case 2 '刷新
Call refresh1
Case 3 '打印
If Not T_TJ = "" Then
Set t_rec = PUB_data.OpenRecordset("select YDD_H,KR_MC,RZRQ,YDSJ,LDRQ,DF_JS,GZ_JS,RS,DFY_DM from " & t_nam & " Where " & T_TJ, 4)
If Not t_rec.BOF Then
t_rec.MoveLast
Dim GDL_X As String
Select Case Trim(m_gdlx1.Text)
Case ""
GDL_X = ""
Case "预订解除"
GDL_X = "预订解除"
Case "预订入住"
GDL_X = "预订入住"
Case "等待解除"
GDL_X = "等待解除"
End Select
If GDL_X = "" Then
Call print_tabler(t_rec, "客房预订档案清单", Array("预订单号", "客人名称", "预达日期", " 预达时间", "预离日期", "预订房数", "管制房数", "人数", "订房员"), Array(18, 25, 15, 15, 12, 8, 10, 6, 8), 40, Array(11, 11, 11, 11, 11, 21, 21, 21, 21))
Else
Call print_tabler(t_rec, "客房" & GDL_X & "档案清单", Array("预订单号", "客人名称", "预达日期", " 预达时间", "预离日期", "预订房数", "管制房数", "人数", "订房员"), Array(18, 25, 15, 15, 12, 8, 10, 6, 8), 40, Array(11, 11, 11, 11, 11, 21, 21, 21, 21))
End If
Else
MsgBox "无可打印信息!", 64
Exit Sub
End If
Else
Set t_rec = PUB_data.OpenRecordset("select YDD_H,KR_MC,RZRQ,YDSJ,LDRQ,DF_JS,GZ_JS,RS,DFY_DM from " & t_nam & "", 4)
If Not t_rec.BOF Then
t_rec.MoveLast
Call print_tabler(t_rec, "客房预订档案清单", Array("预订单号", "客人名称", "预达日期", " 预达时间", "预离日期", "预订房数", "管制房数", "人数", "订房员"), Array(18, 25, 15, 15, 12, 8, 10, 6, 8), 40, Array(11, 11, 11, 11, 11, 21, 21, 21, 21))
Else
MsgBox "无可打印信息!", 64
Exit Sub
End If
End If
End Select
End Sub
Private Sub Cmd3_Click()
Unload Me
yx_main.Show (1)
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_GotFocus()
On Error GoTo error1
m_ydd_h.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9))
m_kr_mc.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 1))
m_rzrq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 9 + 2)) = "", " - - ", Format(FLEX1.TextArray(FLEX1.Row * 9 + 2), "yyyy-mm-dd"))
m_ydsj.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 9 + 3)) = "*", "", Trim(FLEX1.TextArray(FLEX1.Row * 9 + 3)))
m_ldrq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 9 + 4)) = "", " - - ", Format(FLEX1.TextArray(FLEX1.Row * 9 + 4), "yyyy-mm-dd"))
m_df_js.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 5))
m_gz_js.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 6))
m_rs.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 7))
m_dfy_dm.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 8))
Exit Sub
error1:
If Err() = 383 Then
Resume Next
End If
End Sub
Private Sub FLEX1_RowColChange()
On Error GoTo error1
m_ydd_h.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9))
m_kr_mc.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 1))
m_rzrq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 9 + 2)) = "", " - - ", Format(FLEX1.TextArray(FLEX1.Row * 9 + 2), "yyyy-mm-dd"))
m_ydsj.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 9 + 3)) = "*", "", Trim(FLEX1.TextArray(FLEX1.Row * 9 + 3)))
m_ldrq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 9 + 4)) = "", " - - ", Format(FLEX1.TextArray(FLEX1.Row * 9 + 4), "yyyy-mm-dd"))
m_df_js.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 5))
m_gz_js.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 6))
m_rs.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 7))
m_dfy_dm.Text = Trim(FLEX1.TextArray(FLEX1.Row * 9 + 8))
Exit Sub
error1:
If Err() = 383 Then
Resume Next
End If
End Sub
Private Sub m_gdlx1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
m_ydrq1.SetFocus
m_ydrq1.SelStart = 0
m_ydrq1.SelLength = Len(m_ydrq1.Text)
End If
End Sub
Private Sub m_kr_mc1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
m_ydd_h1.SetFocus
m_ydd_h1.SelStart = 0
m_ydd_h1.SelLength = Len(Trim(m_ydd_h1.Text))
End If
End Sub
Private Sub m_ydd_h1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
If Trim(m_gdlx1.Text) = "" Then
T_TJ = ""
Else
Select Case UCase(Trim(m_gdlx1.Text))
Case "预订解除"
T_TJ = "BJ='" & 0 & "'"
Case "预订入住"
T_TJ = "BJ='" & 2 & "'"
Case "等待解除"
T_TJ = "BJ='" & 3 & "'"
End Select
End If
If m_ydrq1.Text <> " - - " Then
If T_TJ = "" Then
T_TJ = T_TJ & "CSTR(YDRQ)='" & m_ydrq1.Text & "'"
Else
T_TJ = T_TJ & "AND CSTR(YDRQ)='" & m_ydrq1.Text & "'"
End If
End If
If Not Trim(m_kr_mc1.Text) = "" Then
If T_TJ = "" Then
T_TJ = T_TJ & "TRIM(KR_MC)='" & UCase(Trim(m_kr_mc1.Text)) & "'"
Else
T_TJ = T_TJ & "AND TRIM(KR_MC)='" & UCase(Trim(m_kr_mc1.Text)) & "'"
End If
End If
If Not Trim(m_ydd_h1.Text) = "" Then
If T_TJ = "" Then
T_TJ = T_TJ & "TRIM(YDD_H)='" & UCase(Trim(m_ydd_h1.Text)) & "'"
Else
T_TJ = T_TJ & "AND TRIM(YDD_H)='" & UCase(Trim(m_ydd_h1.Text)) & "'"
End If
End If
If Not T_TJ = "" Then
Set t_rec = PUB_data.OpenRecordset("select YDD_H,KR_MC,RZRQ,YDSJ,LDRQ,DF_JS,GZ_JS,RS,DFY_DM,KHDM,LOCK_NO from " & t_nam & " Where " & T_TJ, 4)
If Not t_rec.BOF Then
t_rec.MoveLast
t_rec.MoveFirst
Call Flex_full(FLEX1, t_bt, t_rec, t_fields, 8, Array(0, 0, 0, 0, 0, 0, 0, 0, 0))
rec_no.Caption = "当前记录数:" + CStr(FLEX1.Rows - 1)
Call first
Else
response = MsgBox("无满足条件的归档记录!是否继续筛选?", 1, "")
If response = 1 Then
m_gdlx1.SetFocus
Else
Call first
End If
End If
Else
Set t_rec = PUB_data.OpenRecordset("select YDD_H,KR_MC,RZRQ,YDSJ,LDRQ,DF_JS,GZ_JS,RS,DFY_DM,KHDM,LOCK_NO from " & t_nam & "", 4)
If Not t_rec.BOF Then
t_rec.MoveLast
t_rec.MoveFirst
End If
Call pub_memo.Flex_full(FLEX1, t_bt, t_rec, t_fields, 8, Array(0, 0, 0, 0, 0, 0, 0, 0, 0))
rec_no.Caption = "当前记录数:" + CStr(FLEX1.Rows - 1)
t_rec.Close
Call first
End If
End If
End Sub
Private Sub m_ydrq1_Change()
frm_msg.Caption = ""
End Sub
Private Sub m_ydrq1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
If Not m_ydrq1.Text = " - - " Then
t_rq = date_cl(m_ydrq1.Text)
If Not t_rq = "F" Then
m_ydrq1 = t_rq
End If
If IsDate(m_ydrq1.Text) Then
If CDate(m_ydrq1.Text) <= Date Then
m_kr_mc1.SetFocus
m_kr_mc1.SelStart = 0
m_kr_mc1.SelLength = Len(Trim(m_kr_mc1.Text))
Else
frm_msg.Caption = "无效预订日期!"
m_ydrq1.SelStart = 0
m_ydrq1.SelLength = Len(Trim(m_ydrq1.Text))
End If
Else
frm_msg.Caption = "无效预订日期!"
m_ydrq1.SelStart = 0
m_ydrq1.SelLength = Len(Trim(m_ydrq1.Text))
End If
Else
m_kr_mc1.SetFocus
m_kr_mc1.SelStart = 0
m_kr_mc1.SelLength = Len(Trim(m_kr_mc1.Text))
End If
End If
End Sub
Private Sub Timer1_Timer()
JZ_DQSJ2 = Time()
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
key_index = 100
Select Case KeyCode
Case vbKeyF6
key_index = 0 '筛选
Case vbKeySpace
key_index = 1 '查询
Case vbKeyF9
key_index = 2 '刷新
Case vbKeyF5
key_index = 3 '打印
Case vbKeyEscape
key_index = 99 '退出
End Select
Select Case key_index
Case 0, 1, 2, 3
If Frame3.Enabled = False Then
Call Cmd2_Click(key_index)
End If
Case 99
If Frame3.Enabled = False Then
Call Cmd3_Click
Else
Call first
End If
End Select
End Sub
Private Sub first()
Cmd2(0).Enabled = True
Cmd2(1).Enabled = True
Cmd2(2).Enabled = True
Cmd2(3).Enabled = True
Cmd3.Enabled = True
Frame2.Enabled = False
Frame3.Enabled = False
nam.Caption = ""
frm_msg.Caption = ""
If FLEX1.Enabled = False Then
FLEX1.Enabled = True
FLEX1.SetFocus
End If
End Sub
Private Sub refresh1()
frm_msg.Caption = ""
If Not T_TJ = "" Then
Set t_rec = PUB_data.OpenRecordset("select YDD_H,KR_MC,RZRQ,YDSJ,LDRQ,DF_JS,GZ_JS,RS,DFY_DM,KHDM,LOCK_NO from " & t_nam & " Where " & T_TJ, 4)
If Not t_rec.BOF Then
t_rec.MoveLast
End If
Else
Set t_rec = PUB_data.OpenRecordset("select YDD_H,KR_MC,RZRQ,YDSJ,LDRQ,DF_JS,GZ_JS,RS,DFY_DM,KHDM,LOCK_NO from " & t_nam & "", 4)
If Not t_rec.BOF Then
t_rec.MoveLast
End If
End If
Call Flex_full(FLEX1, t_bt, t_rec, t_fields, 8, Array(0, 0, 0, 0, 0, 0, 0, 0, 0))
rec_no.Caption = "当前记录数:" + CStr(FLEX1.Rows - 1)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -