📄 dt_kfhf.frm
字号:
Width = 555
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "新房号"
Height = 195
Left = 5670
TabIndex = 62
Top = 930
Width = 555
End
Begin VB.Label lb_xfmsg
Caption = "新房信息"
ForeColor = &H8000000D&
Height = 195
Left = 7920
TabIndex = 61
Top = 930
Width = 2205
End
Begin VB.Label lb_xkf_lxc
Caption = "房类"
Height = 195
Left = 7170
TabIndex = 60
Top = 930
Width = 675
End
Begin VB.Label lb_ykf_lxc
Caption = "房类"
Height = 195
Left = 1830
TabIndex = 59
Top = 930
Width = 675
End
End
Begin VB.Label frm_msg
Alignment = 1 'Right Justify
ForeColor = &H00C00000&
Height = 330
Left = 5235
TabIndex = 1
Top = 180
Visible = 0 'False
Width = 5685
End
Begin VB.Label Label1
BeginProperty Font
Name = "黑体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 180
TabIndex = 0
Top = 150
Width = 10755
End
End
Attribute VB_Name = "dt_kfhf"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim i As Integer
Dim t_czlsh As String
Dim n_lockno As Integer
'换房人的原房信息
Dim kfhf_zklx_y As Integer
Dim kfhf_kf_lxn_y As Integer
Dim kfhf_ldrq_y As Date
Dim kfhf_td_zh_y As String
Dim kfhf_kr_dj_y As Single
Dim kfhf_zxfe_y As Single
Dim kfhf_kfrs_y As Integer
Dim kfhf_bt_y As String '存储列表显示的表头
Dim kfhf_fields_y As Variant '存储列表显示的字段名
Dim kfhf_fdxs_y As Variant '显示列是否有特殊处理 0 无, 1 有
Dim kfhf_fdcounts_y As Integer '表示列表所显示的字段的个数
Dim kfhf_fls_y As Variant
Dim zy_recYF As Recordset
Dim kfhf_opYF As Boolean
'新房信息
Dim kfhf_zklx_x As Integer
Dim kfhf_kf_lxn_x As Integer
Dim kfhf_ldrq_x As Date
Dim kfhf_kfrs_x As Integer
Dim kfhf_bt_x As String '存储列表显示的表头
Dim kfhf_fields_x As Variant '存储列表显示的字段名
Dim kfhf_fdxs_x As Variant '显示列是否有特殊处理 0 无, 1 有
Dim kfhf_fdcounts_x As Integer '表示列表所显示的字段的个数
Dim kfhf_fls_x As Variant
Dim zy_recXF As Recordset
Dim kfhf_opXF As Boolean
Dim kfhf_hfdj As Single '换出帐页中的定金
Dim kfhf_hfzxfe As Single '换出帐页中的总消费额
Dim kfhf_yzhft As Boolean '当原帐号输入正确时, 处理所选择的帐页
'**************************************************************************************************
'* 功 能 :
'* 作 者 : 梁卫
'* 作成日期 : 1999.02.25
'* 修改日期 : 1999.02.25
'**************************************************************************************************
Sub MAIN(t_gnmc As String)
Label1.Caption = t_gnmc
End Sub
'**************************************************************************************************
'* 功 能 :
'* 作 者 : 梁卫
'* 作成日期 : 1999.02.25
'* 修改日期 : 1999.02.25
'**************************************************************************************************
Private Sub CMD_EXIT_Click()
Dim temp_sql As String
Dim temp_i As Integer
'恢复被选择的帐页内容
If gd_xzh.Rows - 1 <> 0 Then
For temp_i = 1 To gd_xzh.Rows - 1
If Trim(gd_xzh.TextArray(temp_i * kfhf_fdcounts_y)) <> "" Then
temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh.Text), 4) & " WHERE ZH='" & Trim(gd_xzh.TextArray(temp_i * kfhf_fdcounts_x)) & "' AND FSRQ=#" & Trim(gd_xzh.TextArray(temp_i * kfhf_fdcounts_x + 1)) & "# AND PZH='" & Trim(gd_xzh.TextArray(temp_i * kfhf_fdcounts_x + 3)) & "'"
Call tPLock(temp_sql, "W" & Left(Trim(tx_yzh.Text), 4), Trim(tx_yzh.Text), "0")
End If
Next
End If
If kfhf_opYF Then
zy_recYF.Close
End If
If kfhf_opXF Then
zy_recXF.Close
End If
Unload Me
End Sub
'**************************************************************************************************
'* 功 能 : 客人换房
'* 作 者 : 梁卫
'* 作成日期 : 1999.03.29
'* 修改日期 : 1999.03.29
'**************************************************************************************************
Private Sub CMD_HF_Click()
Dim LOCK_REC As Recordset
Dim t_tools As New HOTEL_TOOL.HOTEL_TOOLS
Dim temp_qb As Integer
frm_msg.Visible = False
frm_msg.Caption = ""
'校验原房租和新房租的合法性
If Not PUB_SZJY(tx_kf_fz_y, frm_msg) Then
Exit Sub
End If
If Not PUB_SZJY(tx_kf_fwf_y, frm_msg) Then
Exit Sub
End If
If Not PUB_SZJY(tx_kf_fz_x, frm_msg) Then
Exit Sub
End If
If Not PUB_SZJY(tx_kf_fwf_x, frm_msg) Then
Exit Sub
End If
If Trim(tx_zdh.Text) = "" Then
frm_msg.Visible = True
frm_msg.Caption = "请填写帐单号"
tx_zdh.SetFocus
Exit Sub
End If
kfhf_hfdj = 0
kfhf_hfzxfe = 0
'修改新旧房住客登记卡
If op_qb(0).Value Then
temp_qb = 0
Else
temp_qb = 1
End If
'新房没住人或原房住1人, 修改客房房态表 KF_FTK
If kfhf_kfrs_x = 0 Or kfhf_kfrs_y = 1 Then
'KF_FTK 加锁
Set LOCK_REC = PUB_data.OpenRecordset("select * from SYS_LOCK", 2, 0, 2)
LOCK_REC.FindFirst "TRIM(TABLENAME)='KF_FTK'"
Do While LOCK_REC!CZY <> SYS_USER
If LOCK_REC!CZY = "***" Then
LOCK_REC.Edit
LOCK_REC!CZY = SYS_USER
LOCK_REC.Update
Else
Call t_tools.pub_msg("客房房态表正被其他人使用，请稍后")
LOCK_REC.Requery
LOCK_REC.FindFirst "TRIM(TABLENAME)='KF_FTK'"
End If
Loop
'新房没住人时, 改房态 KF_ZR='1'
If kfhf_kfrs_x = 0 Then
PUB_data.Execute "UPDATE KF_FTK SET KF_ZR='1' WHERE LEFT(TRIM(KF_FH),4)='" & Left(Trim(tx_xzh.Text), 4) & "'"
End If
'原房住 1 人或全部换房时, 改房态 KF_ZR='0',KF_ZF='1'
If kfhf_kfrs_y = 1 Or temp_qb = 1 Then
PUB_data.Execute "UPDATE KF_FTK SET KF_ZF='1', KF_ZR='0' WHERE LEFT(TRIM(KF_FH),4)='" & Left(Trim(tx_yzh.Text), 4) & "'"
End If
'KF_FTK 解锁
LOCK_REC.FindFirst "TRIM(TABLENAME)='KF_FTK'"
LOCK_REC.Edit
LOCK_REC!CZY = "***"
LOCK_REC.Update
LOCK_REC.Close
End If
'修改及归档
Call tPgdjk(temp_qb, pub_code)
'原房: 由 住人 改至 脏房 时, 根据原房类修改客房利用情况统计表
If kfhf_kfrs_y = 1 Or temp_qb = 1 Then
kfhf_fls_y(kfhf_kf_lxn_y) = -1
Call Pub_kftj(Date, kfhf_ldrq_y, kfhf_fls_y, Date, kfhf_ldrq_y, kfhf_fls_y, kfhf_zklx_y, pub_code)
End If
'新房: 由 可卖 改至 住人 时, 根据新房类修改客房利用情况统计表
If kfhf_kfrs_x = 0 Then
kfhf_fls_x(kfhf_kf_lxn_x) = 1
Call Pub_kftj(Date, kfhf_ldrq_x, kfhf_fls_x, Date, kfhf_ldrq_x, kfhf_fls_x, kfhf_zklx_x, pub_code)
End If
If kfhf_opYF Then
zy_recYF.Close
End If
If kfhf_opXF Then
zy_recXF.Close
End If
Unload Me
End Sub
'**************************************************************************************************
'* 功 能 : 选择帐页的功能键
'* 作 者 : 梁卫
'* 作成日期 : 1999.03.30
'* 修改日期 : 1999.03.30
'**************************************************************************************************
Private Sub cmd_sele_Click(Index As Integer)
Dim temp_sql As String
Dim temp_i As Integer
Dim temp_rec As Recordset
Select Case Index
Case 0 '把原帐页中的一条记录选择至新帐页中
If gd_yzh.Rows - 1 <> 0 Then
If Trim(gd_yzh.TextArray(gd_yzh.Row * kfhf_fdcounts_y)) <> "" Then
temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh.Text), 4) & " WHERE TRIM(ZH)='" & Trim(gd_yzh.TextArray(gd_yzh.Row * kfhf_fdcounts_y)) & "' AND FSRQ=#" & Trim(gd_yzh.TextArray(gd_yzh.Row * kfhf_fdcounts_y + 1)) & "# AND PZH='" & Trim(gd_yzh.TextArray(gd_yzh.Row * kfhf_fdcounts_y + 3)) & "'"
Call tPLock(temp_sql, "W" & Left(Trim(tx_yzh.Text), 4), Trim(tx_yzh.Text), "1")
Call Flex_full(gd_yzh, kfhf_bt_y, zy_recYF, kfhf_fields_y, kfhf_fdcounts_y - 1, kfhf_fdxs_y)
Call Flex_full(gd_xzh, kfhf_bt_x, zy_recXF, kfhf_fields_x, kfhf_fdcounts_x - 1, kfhf_fdxs_x)
End If
End If
Case 1 '把新帐页中的一条记录选择至原帐页中
If gd_xzh.Rows - 1 <> 0 Then
If Trim(gd_xzh.TextArray(gd_xzh.Row * kfhf_fdcounts_y)) <> "" Then
temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh.Text), 4) & " WHERE TRIM(ZH)='" & Trim(gd_xzh.TextArray(gd_xzh.Row * kfhf_fdcounts_x)) & "' AND FSRQ=#" & Trim(gd_xzh.TextArray(gd_xzh.Row * kfhf_fdcounts_x + 1)) & "# AND TRIM(PZH)='" & Trim(gd_xzh.TextArray(gd_xzh.Row * kfhf_fdcounts_x + 3)) & "'"
Call tPLock(temp_sql, "W" & Left(Trim(tx_yzh.Text), 4), Trim(tx_yzh.Text), "0")
Call Flex_full(gd_yzh, kfhf_bt_y, zy_recYF, kfhf_fields_y, kfhf_fdcounts_y - 1, kfhf_fdxs_y)
Call Flex_full(gd_xzh, kfhf_bt_x, zy_recXF, kfhf_fields_x, kfhf_fdcounts_x - 1, kfhf_fdxs_x)
End If
End If
Case 2 '把原帐页中剩余的全部记录选择至新帐页中
If gd_yzh.Rows - 1 <> 0 Then
For temp_i = 1 To gd_yzh.Rows - 1
temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh.Text), 4) & " WHERE TRIM(ZH)='" & Trim(gd_yzh.TextArray(temp_i * kfhf_fdcounts_y)) & "' AND FSRQ=#" & Trim(gd_yzh.TextArray(temp_i * kfhf_fdcounts_y + 1)) & "# AND TRIM(PZH)='" & Trim(gd_yzh.TextArray(temp_i * kfhf_fdcounts_y + 3)) & "'"
Call tPLock(temp_sql, "W" & Left(Trim(tx_yzh.Text), 4), Trim(tx_yzh.Text), "1")
Next temp_i
Call Flex_full(gd_yzh, kfhf_bt_y, zy_recYF, kfhf_fields_y, kfhf_fdcounts_y - 1, kfhf_fdxs_y)
Call Flex_full(gd_xzh, kfhf_bt_x, zy_recXF, kfhf_fields_x, kfhf_fdcounts_x - 1, kfhf_fdxs_x)
End If
Case 3 '把新帐页中剩余的全部记录选择至原帐页中
If gd_xzh.Rows - 1 <> 0 Then
For temp_i = 1 To gd_xzh.Rows - 1
temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh.Text), 4) & " WHERE TRIM(ZH)='" & Trim(gd_xzh.TextArray(temp_i * kfhf_fdcounts_x)) & "' AND FSRQ=#" & Trim(gd_xzh.TextArray(temp_i * kfhf_fdcounts_x + 1)) & "# AND TRIM(PZH)='" & Trim(gd_xzh.TextArray(temp_i * kfhf_fdcounts_x + 3)) & "'"
Call tPLock(temp_sql, "W" & Left(Trim(tx_yzh.Text), 4), Trim(tx_yzh.Text), "0")
Next temp_i
Call Flex_full(gd_yzh, kfhf_bt_y, zy_recYF, kfhf_fields_y, kfhf_fdcounts_y - 1, kfhf_fdxs_y)
Call Flex_full(gd_xzh, kfhf_bt_x, zy_recXF, kfhf_fields_x, kfhf_fdcounts_x - 1, kfhf_fdxs_x)
End If
Case 4 '按照条件把原帐页中的记录选择至新帐页中
If Trim(tx_zh.Text) <> "" Or Trim(tx_from.Text) <> "____-__-__" Or Trim(tx_to.Text) <> "____-__-__" Or Trim(tx_pzh.Text) <> "" Then
temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh.Text), 4) & " WHERE CZBJ='0' AND JS_FT='0' AND CLYDM='***' "
If Trim(tx_zh.Text) <> "" Then
temp_sql = temp_sql & " AND TRIM(ZH)='" & Trim(tx_zh.Text) & "' "
End If
If Trim(tx_from.Text) <> "____-__-__" Or Trim(tx_to.Text) <> "____-__-__" Then
If Trim(tx_from.Text) <> "____-__-__" And Trim(tx_to.Text) <> "____-__-__" Then
temp_sql = temp_sql & " AND FSRQ>=#" & Trim(tx_from.Text) & "# AND FSRQ<=#" & Trim(tx_to.Text) & "# "
Else
If Trim(tx_from.Text) <> "____-__-__" Then
temp_sql = temp_sql & " AND FSRQ>=#" & Trim(tx_from.Text) & "# "
Else
temp_sql = temp_sql & " AND FSRQ<=#" & Trim(tx_to.Text) & "# "
End If
End If
End If
If Trim(tx_pzh.Text) <> "" Then
temp_sql = temp_sql & " AND TRIM(PZH)='" & Trim(tx_pzh.Text) & "' "
End If
Set temp_rec = PUB_data.OpenRecordset(temp_sql, 4, 0, 2)
If Not temp_rec.BOF Then
temp_rec.MoveLast
temp_rec.MoveFirst
Do While Not temp_rec.EOF
temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh), 4) & " WHERE TRIM(ZH)='" & temp_rec.Fields("ZH") & "' AND FSRQ=#" & temp_rec.Fields("FSRQ") & "# AND TRIM(PZH)='" & temp_rec.Fields("PZH") & "'"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -