📄 zfht_pop.frm
字号:
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3360
TabIndex = 32
Top = 2760
Width = 1995
End
Begin VB.Label Label17
AutoSize = -1 'True
Caption = "房间租金:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 6840
TabIndex = 31
Top = 2760
Width = 945
End
Begin VB.Label Label18
AutoSize = -1 'True
Caption = "联系电话:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 240
TabIndex = 30
Top = 3240
Width = 945
End
Begin VB.Label Label19
AutoSize = -1 'True
Caption = "联系传真:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3840
TabIndex = 29
Top = 3240
Width = 945
End
Begin VB.Label Label20
AutoSize = -1 'True
Caption = "签字日期:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 240
TabIndex = 28
Top = 3840
Width = 945
End
Begin VB.Label Label21
AutoSize = -1 'True
Caption = "定金数额:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3360
TabIndex = 27
Top = 3840
Width = 945
End
Begin VB.Label Label22
AutoSize = -1 'True
Caption = "乙方地址:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 240
TabIndex = 26
Top = 4440
Width = 945
End
Begin VB.Label Label23
AutoSize = -1 'True
Caption = "定金付款方式:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 240
TabIndex = 25
Top = 5040
Width = 1365
End
End
Begin VB.Label frm_msg
AutoSize = -1 'True
BackColor = &H00C0C0C0&
ForeColor = &H00FF0000&
Height = 180
Left = 7080
TabIndex = 51
Top = 360
Width = 210
End
Begin VB.Label Label24
AutoSize = -1 'True
Caption = "租房合同数据"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 3240
TabIndex = 50
Top = 240
Width = 1995
End
End
End
Attribute VB_Name = "zfht_pop"
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 pub_no As Integer
Dim pass As String
Dim t_lock_no As Integer
Dim response As String
Dim response1 As String
Dim t_rec3 As Recordset 'ADDNEW,EDIT,DELETE
Dim t_rec4 As Recordset 'LOCK_NO
Dim t_rec As Recordset 'MSFLEXGRID
Dim t_rec2 As Recordset 'TEMP
Dim t_rq As String
Dim t_f As Boolean
Dim rec As Recordset
Private Sub Form_Load()
KeyPreview = True
Select Case STY
Case "0"
Frame1.Caption = "建立"
Call jl
Case "1"
Frame1.Caption = "修改"
Call xg
Case "2"
Frame1.Caption = "解除"
Call sc
Case "5"
Frame1.Caption = "查询"
Call cx
End Select
End Sub
Private Sub CMD1_Click()
Select Case STY
Case "0" '增加
'生成租房合同单号
Set rec = YX_data.OpenRecordset("SELECT RQ,ZFHT_NO,LOCK_NO FROM NO WHERE CSTR(RQ)='" & Date & "'", 2, 0, 2)
If Not rec.BOF Then
rec.MoveLast
'加锁
Do
Select Case Pub_lock("YX", "NO", rec) '判断加锁结果
Case "1" '锁定
Exit Do
Case "2" '
Call Pub_UNlock("NO", rec)
Exit Sub
End Select
Loop
rec.Edit
rec!ZFHT_NO = rec!ZFHT_NO + 1
rec.Update
End If
' ^&^&^&^&^&^&^&^& 增加...
Set t_rec = YX_data.OpenRecordset("select HTDM,ZYF,QSRQ,JZRQ,FK_FH,KF_FZ,FJYT,JFDB,JFDB_ZW,YFDB,YFDB_ZW,KF_LXN,KF_FS,FKZH,CZDB,BZ,KF_LXC,LXDH,LXCZ,QZRQ,KR_DJ,DZ,DJ_FKMC,LOCK_NO from YX_ZFHT", 2, 0, 2)
If Not t_rec.BOF Then
t_rec.MoveLast
End If
With t_rec
.AddNew
!HTDM = "ZF" & CStr(Format(Date, "yyyymmdd")) & Right("0" & CStr(rec!ZFHT_NO), 2)
!JFDB = IIf(Trim(m_jfdb.Text) = "", "*", UCase(Trim(m_jfdb.Text)))
!JFDB_ZW = IIf(Trim(m_jfdb_zw.Text) = "", "*", UCase(Trim(m_jfdb_zw.Text)))
!ZYF = IIf(Trim(m_zyf.Text) = "", "*", UCase(Trim(m_zyf.Text)))
!YFDB = IIf(Trim(m_yfdb.Text) = "", "*", UCase(Trim(m_yfdb.Text)))
!YFDB_ZW = IIf(Trim(m_yfdb_zw.Text) = "", "*", UCase(Trim(m_yfdb_zw.Text)))
!FKZH = IIf(Trim(m_fk_zh.Text) = "", "*", UCase(Trim(m_fk_zh.Text)))
!FK_FH = IIf(Trim(m_fk_fh.Text) = "", "*", UCase(Trim(m_fk_fh.Text)))
!CZDB = IIf(Trim(m_czdb.Text) = "", "*", UCase(Trim(m_czdb.Text)))
!BZ = IIf(Trim(m_bz.Text) = "", "*", UCase(Trim(m_bz.Text)))
!KF_LXC = IIf(Trim(m_kf_lxc.Text) = "", "*", UCase(Trim(m_kf_lxc.Text)))
!LXDH = IIf(Trim(m_lxdh.Text) = "", "*", UCase(Trim(m_lxdh.Text)))
!LXCZ = IIf(Trim(m_lxcz.Text) = "", "*", UCase(Trim(m_lxcz.Text)))
!dz = IIf(Trim(m_dz.Text) = "", "*", UCase(Trim(m_dz.Text)))
!dj_fkmc = IIf(Trim(m_dj_fkmc.Text) = "", "*", UCase(Trim(m_dj_fkmc.Text)))
!FJYT = IIf(Trim(m_fjyt.Text) = "", "*", UCase(Trim(m_fjyt.Text)))
!KF_LXN = CDec(Trim(m_kf_lxn.Text))
!KF_FS = CDec(Trim(m_kf_fs.Text))
!kr_dj = CDec(Trim(m_kr_dj.Text))
!kf_fz = CDec(Trim(m_kf_fz.Text))
!QSRQ = CDate(m_qsrq.Text)
!JZRQ = CDate(m_jzrq.Text)
!QZRQ = CDate(m_qzrq.Text)
!lock_no = 0
Dim t_dhh As String
t_dhh = t_rec!HTDM
.Update
End With
Call Pub_UNlock("NO", rec)
t_f = True
MsgBox "租房合同成功建立!" & "租房合同单号" & t_dhh, vbOKOnly
Unload Me
Case "1" '修改
Set t_rec3 = YX_data.OpenRecordset("select * from YX_ZFHT where HTDM='" & Trim(UCase(m_htdm.Text)) & " '", 2, 0, 2)
If Not t_rec3.BOF Then
t_rec3.MoveLast
'加锁
Do
Select Case Pub_lock("PUBLIC", "YX_ZFHT", t_rec3)
Case "1"
Exit Do
Case "2"
Call Pub_UNlock("YX_ZFHT", t_rec3)
Exit Sub
End Select
Loop
With t_rec3
.Edit
!JFDB = IIf(Trim(m_jfdb.Text) = "", "*", UCase(Trim(m_jfdb.Text)))
!JFDB_ZW = IIf(Trim(m_jfdb_zw.Text) = "", "*", UCase(Trim(m_jfdb_zw.Text)))
!ZYF = IIf(Trim(m_zyf.Text) = "", "*", UCase(Trim(m_zyf.Text)))
!YFDB = IIf(Trim(m_yfdb.Text) = "", "*", UCase(Trim(m_yfdb.Text)))
!YFDB_ZW = IIf(Trim(m_yfdb_zw.Text) = "", "*", UCase(Trim(m_yfdb_zw.Text)))
!FKZH = IIf(Trim(m_fk_zh.Text) = "", "*", UCase(Trim(m_fk_zh.Text)))
!FK_FH = IIf(Trim(m_fk_fh.Text) = "", "*", UCase(Trim(m_fk_fh.Text)))
!CZDB = IIf(Trim(m_czdb.Text) = "", "*", UCase(Trim(m_czdb.Text)))
!BZ = IIf(Trim(m_bz.Text) = "", "*", UCase(Trim(m_bz.Text)))
!KF_LXC = IIf(Trim(m_kf_lxc.Text) = "", "*", UCase(Trim(m_kf_lxc.Text)))
!LXDH = IIf(Trim(m_lxdh.Text) = "", "*", UCase(Trim(m_lxdh.Text)))
!LXCZ = IIf(Trim(m_lxcz.Text) = "", "*", UCase(Trim(m_lxcz.Text)))
!dz = IIf(Trim(m_dz.Text) = "", "*", UCase(Trim(m_dz.Text)))
!dj_fkmc = IIf(Trim(m_dj_fkmc.Text) = "", "*", UCase(Trim(m_dj_fkmc.Text)))
!FJYT = IIf(Trim(m_fjyt.Text) = "", "*", UCase(Trim(m_fjyt.Text)))
!KF_LXN = CDec(Trim(m_kf_lxn.Text))
!KF_FS = CDec(Trim(m_kf_fs.Text))
!kr_dj = CDec(Trim(m_kr_dj.Text))
!kf_fz = CDec(Trim(m_kf_fz.Text))
!QSRQ = CDate(m_qsrq.Text)
!JZRQ = CDate(m_jzrq.Text)
!QZRQ = CDate(m_qzrq.Text)
.Update
End With
'解锁
Call Pub_UNlock("YX_ZFHT", t_rec3)
t_f = True
Unload Me
End If
Case "2"
Set t_rec2 = YX_data.OpenRecordset("select HTDM from YX_ZFHT Where HTDM='" & Trim(m_htdm.Text) & "' ", 4)
If Not t_rec2.BOF Then
t_rec2.MoveLast
'加锁
Do
Select Case Pub_lock("PUBLIC", "YX_ZFHT", t_rec2)
Case "1"
Exit Do
Case "2"
Call Pub_UNlock("YX_ZFHT", t_rec2)
Exit Sub
End Select
Loop
Dim zfh_t As String
zfh_t = "ZFHT" & year(Format(Date, "yyyy-mm-dd"))
YX_data.Execute "INSERT INTO " & zfh_t & " SELECT * FROM YX_ZFHT WHERE HTDM='" & UCase(Trim(m_htdm.Text)) & "'"
YX_data.Execute "DELETE FROM YX_ZFHT WHERE HTDM='" & UCase(Trim(m_htdm.Text)) & "'"
Call Pub_UNlock("YX_ZFHT", t_rec2)
End If
t_f = True
Unload Me
End Select
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
Call Cmd2_Click
End If
End Sub
Private Sub m_bz_GotFocus()
m_bz.SelStart = 0
m_bz.SelLength = Len(Trim(m_bz.Text))
End Sub
Private Sub m_bz_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
m_kf_lxn.SetFocus
End If
End Sub
Private Sub m_czdb_GotFocus()
m_czdb.SelStart = 0
m_czdb.SelLength = Len(Trim(m_czdb.Text))
End Sub
Private Sub m_czdb_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
m_bz.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -