⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 thrz.frm

📁 酒店管理系统
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 

Private Sub DTPicker2_Validate(Cancel As Boolean)
    Label5.Caption = Format(DTPicker2.Value, "long date")
End Sub

Private Sub Form_Activate()
    If Data1.Recordset.RecordCount = 0 Then MNU21_Click
    Data2.RecordSource = "SELECT 团会房间安排.ID, 团会房间安排.团会ID, 团会房间安排.房号, 团会房间安排.姓名, 团会房间安排.性别, 团会房间安排.房价 From 团会房间安排 WHERE (((团会房间安排.团会ID)='" + Text6.Text + "'))"
    Data2.Refresh
    If IsNumeric(Text5.Text) Then Text5.Text = FormatNumber(Text5.Text, 2, vbTrue, , vbFalse)
    If IsNumeric(Text5.Text) Then
       If CDbl(Text5.Text) <> 0 Then
          Label2(7).Caption = "<大写>人民币" + SUMDM(CDbl(Text5.Text))
          Else
            Label2(7).Caption = "<大写>"
       End If
    End If
    With dbFind1
        .DatabaseName = Data3.DatabaseName
        .RecordSource = Data3.RecordSource
        .Refresh
        .BoundColumn = "房号"
        .ListField = "房情"
        .Refresh
    End With
    dbFind1.Caption = "请选择入住房号"
    Label5.Caption = Format(Label5.Caption, "long date")
    Label6.Caption = Format(Label6.Caption, "long date")


End Sub

Private Sub Form_Load()
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECHJZT = DATJDGL.OpenRecordset("房间状态", dbOpenDynaset)
    Set RECKRZD = DATJDGL.OpenRecordset("客人帐单", dbOpenDynaset)
    
    Data1.DatabaseName = App.Path & "\data\jdgl.mdb"
    Data1.Refresh
    Data2.DatabaseName = App.Path & "\data\jdgl.mdb"
    Data2.Refresh
    Data3.DatabaseName = App.Path & "\data\jdgl.mdb"
    Data3.Refresh
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DATJDGL.Close
End Sub

Private Sub MNU11_Click()      '打印机设置
    CDLTEST.flags = cdlPDDisablePrintToFile
    CDLTEST.Copies = 3
    CDLTEST.PrinterDefault = True
    CDLTEST.ShowPrinter

End Sub

Private Sub MNU12_Click()
    Data2.UpdateRecord
    Load THRZPREVIEW
    THRZPREVIEW.Show vbModal
End Sub

Private Sub MNU13_Click()
    THRZPREVIEW.Toolbar1_ButtonClick THRZPREVIEW.Toolbar1.Buttons(2)
    THRZPREVIEW.Toolbar1_ButtonClick THRZPREVIEW.Toolbar1.Buttons(1)
    Unload THRZPREVIEW

End Sub

Private Sub MNU16_Click()     ' 退出模块
    DATJDGL.Close
    Unload Me
    
End Sub

Private Sub MNU21_Click()
    Dim maxrec As Recordset
    Dim RECNO As String
    RECNO = ""
    If Data1.Recordset.EditMode = 2 Then
       RECNO = Text6.Text
       RECNO = left(RECNO, 8) + right(Trim(CStr(CLng(right(RECNO, 4)) + 10001)), 4)
       Else
         Set maxrec = DATJDGL.OpenRecordset("SELECT DISTINCTROW Max(团会登记表.团会ID) AS 团会ID From 团会登记表 HAVING (((Left([团会ID],8))=CStr(Year(Now()))+Right(CStr(100+Month(Now())),2)+Right(CStr(100+Day(Now())),2)))", dbOpenSnapshot)
         RECNO = IIf(Not IsNull(maxrec("团会ID")), maxrec("团会ID"), "")
         Set maxrec = DATJDGL.OpenRecordset("SELECT DISTINCTROW Max(团会结帐.团会ID) AS 团会ID From 团会结帐 HAVING (((Left([团会ID],8))=CStr(Year(Now()))+Right(CStr(100+Month(Now())),2)+Right(CStr(100+Day(Now())),2)))", dbOpenSnapshot)
         If Not IsNull(maxrec("团会ID")) Then
            If RECNO < maxrec("团会ID") Then RECNO = maxrec("团会ID")
         End If
         If RECNO <> "" Then
            RECNO = left(RECNO, 8) + right(Trim(CStr(CLng(right(RECNO, 4)) + 10001)), 4)
            Else
              RECNO = CStr(Year(Now())) + IIf(Len(CStr(Month(Now()))) = 1, "0" + CStr(Month(Now())), CStr(Month(Now()))) + IIf(Len(CStr(Day(Now()))) = 1, "0" + CStr(Day(Now())), CStr(Day(Now()))) + "0001"
         End If
         maxrec.Close
    End If
    Data1.UpdateRecord
    Data1.Recordset.AddNew
    Data1.Recordset("住房") = True
    Data1.Recordset("班次") = frmLogin.CZYBC
    Text6.Text = RECNO
    DTPicker1.Value = Now
    Label3.Caption = Now
    DTPicker2.Value = Now + 1
    Text9.Text = frmLogin.CZYXM
    Chang
End Sub

Private Sub MNU22_Click()     ' 删除记录
    If Data1.Recordset.RecordCount = 0 Then Exit Sub
    SFOK = MsgBox("是否删除当前登记表?", vbYesNo + vbQuestion, "提示信息")
    If SFOK = vbYes Then
       If Data1.Recordset.EditMode = 2 Then
          Data1.UpdateControls
          Data1.Refresh
          Else
            RECKRZD.FindFirst ("团会ID='" & Data1.Recordset("团会ID") & "'")
            If Not RECKRZD.NoMatch Then
               MsgBox "经查已存在此团会明细帐单!不能删除...", vbCritical, "提示信息"
               Exit Sub
               Else
                 Data1.Recordset.Delete
                 If Not Data1.Recordset.EOF Then
                    Data1.Recordset.MoveNext
                    If Data1.Recordset.EOF And Data1.Recordset.RecordCount > 0 Then Data1.Recordset.MoveLast
                    Else
                      Data1.Recordset.MoveLast
                 End If
            End If
       End If
    End If
    
End Sub

Private Sub MNU23_Click()
    MYID = Text6.Text
    Data1.UpdateControls
    Data1.Refresh
    Data1.Recordset.FindFirst ("团会ID='" & MYID & "'")
    Save
End Sub

Private Sub MNU26_Click()
    If Data1.Recordset.RecordCount > 0 Then Chang

End Sub

Private Sub MNU27_Click()
    Set RECYD = DATJDGL.OpenRecordset("预订单", dbOpenDynaset)
    If RECYD.RecordCount = 0 Then
       MsgBox "系统中无可选预定单!", vbCritical, "提示信息"
       Exit Sub
    End If
    Load YDRZ
    YDRZ.Show vbModal
    If YDRZ.STRYD1 <> "" Then
       MNU21_Click
       Text2.Text = YDRZ.STRYD2
       Text1(8).Text = YDRZ.STRYD6
       Text5.Text = FormatCurrency(YDRZ.CURYD, , vbTrue)
       RECYD.FindFirst ("定房卡号='" & YDRZ.STRYD1 & "'")
       If Not RECYD.NoMatch Then RECYD.Delete
    End If
End Sub

Private Sub MNU28_Click()
    MYID = Text6.Text
    Data1.UpdateRecord
    Data1.Recordset.FindFirst ("团会ID='" & MYID & "'")
    Save

End Sub

Private Sub MNU3_Click()
    If Data1.Recordset.RecordCount = 0 Then Exit Sub
    Load SKRZCXWIN
    SKRZCXWIN.Caption = "住房团会登记"
    SKRZCXWIN.Show vbModal
    If SKRZCXWIN.STRKRID <> "" Then Data1.Recordset.FindFirst ("团会ID='" & SKRZCXWIN.STRKRID & "'")

End Sub

Private Sub MNU4_Click()            ' 计算器
    Dim jsq As Double
    jsq = Shell("calc", vbNormalNoFocus)
 
End Sub

Private Sub MNU51_Click()
    Shell App.Path & "\hh.exe " & App.Path & "\help.chm", vbNormalFocus
End Sub

Private Sub MNU54_Click()          ' 关于对话
    Load frmAbout
    frmAbout.Show vbModal
    
End Sub

Private Sub POP11_Click()
    Dim STRMID As String
    Dim INTMID As Integer
    If Data1.Recordset.RecordCount = 0 Or Data1.Recordset.EOF Then Exit Sub
    If Data1.Recordset.EditMode = 2 Then
       STRMID = Text6.Text
       Data1.Recordset.Update
       Data1.Recordset.FindFirst ("团会ID='" & STRMID & "'")
    End If
    If DBGrid1.DataChanged Then
       Data2.UpdateRecord
    End If
    Data2.Recordset.AddNew
    INTMID = Data2.Recordset("ID")
    Data2.Recordset("团会ID") = Text6.Text
    Data2.Recordset.Update
    Data2.Recordset.FindFirst ("ID=" & INTMID)
    'Data2.Refresh
    
End Sub

Private Sub POP12_Click()
    If Data2.Recordset.RecordCount = 0 Then Exit Sub
    If Data2.Recordset.EOF Then
       MsgBox "请选择需删除的记录!", vbCritical, "错误"
       Exit Sub
    End If
    SFOK = MsgBox("是否删除当前团会成员?", vbYesNo + vbQuestion, "房间安排")
    If SFOK = vbYes Then
       Data2.Recordset.Delete
       If Not Data2.Recordset.EOF Then
          Data2.Recordset.MoveNext
          If Data2.Recordset.EOF And Data2.Recordset.RecordCount > 0 Then Data2.Recordset.MoveLast
          Else
            Data2.Recordset.MoveLast
       End If
    End If

End Sub
Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       If Text2.DataChanged = True Then
          Label4.Caption = PYM(Text2.Text)
       End If
       Text3.SetFocus
    End If
    
End Sub

Private Sub Text2_Validate(Cancel As Boolean)
    If Text2.DataChanged = True Then
       Label4.Caption = PYM(Text2.Text)
    End If

End Sub

Private Sub Text3_GotFocus()
    Text3.SelStart = 0
    Text3.SelLength = Len(Text3.Text)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    
    If KeyAscii = 13 Then
       If Not IsNumeric(Text3.Text) Then Text3.Text = 0
       Text4.SetFocus
    End If
    STRVALID = "0123456789"
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
End Sub

Private Sub Text3_Validate(Cancel As Boolean)
    If Not IsNumeric(Text3.Text) Then Text3.Text = 0
End Sub

Private Sub Text4_GotFocus()
    Text4.SelStart = 0
    Text4.SelLength = Len(Text4.Text)
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    
    If KeyAscii = 13 Then
       If Not IsNumeric(Text4.Text) Then Text4.Text = 0
       SendKeys "{TAB}"
    End If
    STRVALID = "0123456789"
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
End Sub

Private Sub Text4_Validate(Cancel As Boolean)
    If Not IsNumeric(Text4.Text) Then Text4.Text = 0
End Sub

Private Sub Text5_GotFocus()
    Text5.SelStart = 0
    Text5.SelLength = Len(Text5.Text)
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    
    If KeyAscii = 13 Then
       If Not IsNumeric(Text5.Text) Then Text5.Text = 0
       Text5.Text = FormatNumber(Text5.Text, 2, vbTrue, , vbFalse)
       If IsNumeric(Text5.Text) Then
          If CDbl(Text5.Text) <> 0 Then
             Label2(7).Caption = "<大写>人民币" + SUMDM(CDbl(Text5.Text))
             Else
               Label2(7).Caption = "<大写>"
          End If
       End If
       Text2.SetFocus
    End If
    STRVALID = "0123456789.+-"
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
End Sub

Private Sub Text5_Validate(Cancel As Boolean)
    If Not IsNumeric(Text5.Text) Then Text5.Text = 0
    Text5.Text = FormatNumber(Text5.Text, 2, vbTrue, , vbFalse)
    If IsNumeric(Text5.Text) Then
       If CDbl(Text5.Text) <> 0 Then
          Label2(7).Caption = "<大写>人民币" + SUMDM(CDbl(Text5.Text))
          Else
            Label2(7).Caption = "<大写>"
       End If
    End If

End Sub


Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case UCase(Button.Key)
        Case "A"          ' 打印
            MNU13_Click
        Case "B"          ' 打印预览
            MNU12_Click
        Case "E"          ' 增加
            MNU21_Click
        Case "EDIT"       ' 修改
            MNU26_Click
        Case "SAVE"       ' 保存
            MNU28_Click
        Case "O"          ' 删除
            MNU23_Click
        Case "F"          ' 恢复增加
            MNU22_Click
            
        Case "G"          ' 删除
            MNU22_Click
        Case "I"          ' 查看
            MNU3_Click
            
        Case "K"          ' 计算器
            MNU4_Click
        Case "M"          ' 帮助
            MNU51_Click
        Case "N"          ' 退出
            Unload Me
    End Select
End Sub
Private Sub Chang()      '可修改状态
    Text1(8).Locked = False
    Text2.Locked = False
    Text3.Locked = False
    Text4.Locked = False
    Text5.Locked = False
    DTPicker1.Visible = True
    DTPicker2.Visible = True
    Label5.Visible = False
    Label6.Visible = False
        
    Text1(8).BackColor = &H80000005
    Text2.BackColor = &H80000005
    Text3.BackColor = &H80000005
    Text4.BackColor = &H80000005
    Text5.BackColor = &H80000005
    
    '置有效或无效菜单
    Toolbar1.Buttons("E").Enabled = False
    Toolbar1.Buttons("G").Enabled = False
    Toolbar1.Buttons("EDIT").Enabled = False
    Toolbar1.Buttons("I").Enabled = False
    Toolbar1.Buttons("O").Enabled = True
    Toolbar1.Buttons("SAVE").Enabled = True
    Me.MNU21.Enabled = False
    Me.MNU22.Enabled = False
    Me.MNU26.Enabled = False
    Me.MNU27.Enabled = False
    Me.MNU3.Enabled = False
    Me.MNU23.Enabled = True
    Me.MNU28.Enabled = True
    
    DBGrid1.AllowUpdate = True
    DBGrid1.Columns(2).Button = True
    Data1.Enabled = False

End Sub
Private Sub Save()      '保存修改
    Text1(8).Locked = True
    Text2.Locked = True
    Text3.Locked = True
    Text4.Locked = True
    Text5.Locked = True
    DTPicker1.Visible = False
    DTPicker2.Visible = False
    Label5.Visible = True
    Label6.Visible = True
        
    Text1(8).BackColor = &H8000000F
    Text2.BackColor = &H8000000F
    Text3.BackColor = &H8000000F
    Text4.BackColor = &H8000000F
    Text5.BackColor = &H8000000F
    
    '置有效或无效菜单
    Toolbar1.Buttons("E").Enabled = True
    Toolbar1.Buttons("G").Enabled = True
    Toolbar1.Buttons("EDIT").Enabled = True
    Toolbar1.Buttons("I").Enabled = True
    Toolbar1.Buttons("O").Enabled = False
    Toolbar1.Buttons("SAVE").Enabled = False
    Me.MNU21.Enabled = True
    Me.MNU22.Enabled = True
    Me.MNU26.Enabled = True
    Me.MNU27.Enabled = True
    Me.MNU3.Enabled = True
    Me.MNU23.Enabled = False
    Me.MNU28.Enabled = False
    
    DBGrid1.AllowUpdate = False
    DBGrid1.Columns(2).Button = False
    Data1.Enabled = True
    
End Sub
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -