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

📄 ydfj.frm

📁 酒店管理系统
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
    Label2.Caption = Format(Label2.Caption, "long date")

End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
    If Action = 11 Then
       If Me.MNU28.Enabled Then
          If MsgBox("当前数据没有保存!请确认是否放弃?", vbQuestion + vbYesNo, "提示信息") = vbNo Then
             Action = 0
             Save = 0
             Exit Sub
             Else
               Save = 0
          End If
       End If
    End If

End Sub

Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{tab}"
End Sub
Private Sub DTPicker2_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{tab}"
End Sub

Private Sub Form_Activate()
    If Data1.Recordset.RecordCount = 0 Then
       XH1 = 0
       XH1 = XH1 + 10001
       Data1.Recordset.AddNew
       Data1.Recordset("班次") = frmLogin.CZYBC
       Data1.Recordset("操作员") = frmLogin.CZYXM
       Data1.Recordset("房价") = 0
       Data1.Recordset("房间数") = 0
       Data1.Recordset("预付款") = 0
       Text1(0).Text = CStr(Year(Now)) + MID(CStr(100 + Month(Now)), 2) + MID(CStr(100 + Day(Now)), 2) + MID(CStr(XH1), 2)
       Chang
    End If
    If IsNumeric(Text1(7).Text) Then Text1(7).Text = FormatNumber(Text1(7).Text, 2, vbTrue, , vbFalse)
    If IsNumeric(Text1(5).Text) Then Text1(5).Text = FormatNumber(Text1(5).Text, 2, vbTrue, , vbFalse)
    Label13.Caption = Format(Label13.Caption, "long date")
    Label2.Caption = Format(Label2.Caption, "long date")

End Sub

Private Sub Form_Load()
    DTPicker1.Value = Now
    DTPicker2.Value = Now
    Data1.DatabaseName = App.Path & "\data\jdgl.mdb"
    Data1.Refresh
    
End Sub
Private Sub MNU11_Click()      '打印机设置
    CDLTEST.flags = cdlPDDisablePrintToFile
    CDLTEST.Copies = 3
    CDLTEST.PrinterDefault = True
    CDLTEST.ShowPrinter

End Sub

Private Sub MNU12_Click()
    YDFJPREVIEW.Show vbModal
    
End Sub

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

Private Sub MNU16_Click()     ' 退出模块
    Unload Me
    
End Sub
Private Sub MNU21_Click()
    On Error GoTo EXITSUB
    
    XH1 = 0
    If Data1.Recordset.EditMode = 2 Then
       RECNO = Text1(0)
       XH1 = right(RECNO, 4)
       Else
         If Data1.Recordset.RecordCount > 0 Then Data1.Recordset.MoveFirst
         Do While Not Data1.Recordset.EOF
            XH2 = CInt(MID(Data1.Recordset("定房卡号"), 9, 4))
            XH1 = IIf(XH1 > XH2, XH1, XH2)
            Data1.Recordset.MoveNext
         Loop
    End If
    XH1 = XH1 + 10001
    If Data1.Recordset.RecordCount = 0 Then
       Data1.Refresh
       Else
         Data1.UpdateRecord
    End If
    Data1.Recordset.AddNew
    Data1.Recordset("班次") = frmLogin.CZYBC
    Data1.Recordset("操作员") = frmLogin.CZYXM
    Data1.Recordset("房价") = 0
    Data1.Recordset("房间数") = 0
    Data1.Recordset("预付款") = 0
    Text1(0).Text = CStr(Year(Now)) + MID(CStr(100 + Month(Now)), 2) + MID(CStr(100 + Day(Now)), 2) + MID(CStr(XH1), 2)
    Chang
    Exit Sub
    
EXITSUB:
    SFOK = MsgBox(CStr(Err.Number) & "-" & Err.Description, vbCritical + vbAbortRetryIgnore, "错误信息")
    If SFOK = vbAbort Then
       Unload Me
       Else
         If SFOK = vbRetry Then
            Resume
            Else
              Resume Next
         End If
    End If
    
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
            If Data1.Recordset.RecordCount > 0 Then
               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
               Else
                 MsgBox "没有预订卡删除!", vbInformation, "提示信息"
            End If
       End If
    End If
    
End Sub

Private Sub MNU23_Click()
    On Error GoTo EXITSUB
    
    MYID = Text1(0).Text
    Data1.UpdateControls
    Data1.Refresh
    Data1.Recordset.FindFirst ("定房卡号='" & MYID & "'")
    Save
    Exit Sub
    
EXITSUB:
    SFOK = MsgBox(CStr(Err.Number) & "-" & Err.Description, vbCritical + vbAbortRetryIgnore, "错误信息")
    If SFOK = vbAbort Then
       Unload Me
       Else
         If SFOK = vbRetry Then
            Resume
            Else
              Resume Next
         End If
    End If

End Sub

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

End Sub

Private Sub MNU28_Click()
    On Error GoTo EXITSUB
    
    MYID = Text1(0).Text
    Data1.UpdateRecord
    Data1.Recordset.FindFirst ("定房卡号='" & MYID & "'")
    Save
    Exit Sub
    
EXITSUB:
    SFOK = MsgBox(CStr(Err.Number) & "-" & Err.Description, vbCritical + vbAbortRetryIgnore, "错误信息")
    If SFOK = vbAbort Then
       Unload Me
       Else
         If SFOK = vbRetry Then
            Resume
            Else
              Resume Next
         End If
    End If
    
End Sub

Private Sub MNU3_Click()
    If Data1.Recordset.RecordCount = 0 Then
       MsgBox "系统中无可选预定单!", vbCritical, "提示信息"
       Exit Sub
    End If
    Load YDRZ
    YDRZ.Show vbModal
    Data1.Recordset.FindFirst ("定房卡号='" & YDRZ.STRYD1 & "'")
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 Text1_GotFocus(Index As Integer)
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(Index).Text)

End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 And Index <> 8 Then
       SendKeys "{TAB}"
       If IsNumeric(Text1(5).Text) Then
          Text1(5).Text = FormatNumber(Text1(5).Text, 2, vbTrue, , vbFalse)
          Else
            Text1(5).Text = " "
       End If
       If IsNumeric(Text1(7).Text) Then
          Text1(7).Text = FormatNumber(Text1(7).Text, 2, vbTrue, , vbFalse)
          Else
            Text1(7).Text = " "
       End If
    End If
    Dim STRVALID As String
    If Index = 6 Or Index = 7 Or Index = 5 Then
       If Index = 6 Then
          STRVALID = "0123456789"
          Else
            STRVALID = "0123456789.+-"
       End If
       If KeyAscii > 26 Then
          If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
             KeyAscii = 0
          End If
       End If
    End If
End Sub

Private Sub Text1_Validate(Index As Integer, Cancel As Boolean)
    If Index = 5 Or Index = 7 Then
       If IsNumeric(Text1(5).Text) Then
          Text1(5).Text = FormatNumber(Text1(5).Text, 2, vbTrue, , vbFalse)
          Else
            Text1(5).Text = "0"
       End If
       If IsNumeric(Text1(7).Text) Then
          Text1(7).Text = FormatNumber(Text1(7).Text, 2, vbTrue, , vbFalse)
          Else
            Text1(7).Text = "0"
       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 "C"          ' 文件输出
            MsgBox "C"
        Case "E"          ' 增加
            MNU21_Click
        Case "EDIT"       ' 修改
            MNU26_Click
        Case "SAVE"       ' 保存
            MNU28_Click
        Case "O"          ' 恢复增加
            SFADD = False
            MNU23_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(1).Locked = False
    Text1(2).Locked = False
    Text1(3).Locked = False
    Text1(4).Locked = False
    Text1(5).Locked = False
    Text1(6).Locked = False
    Text1(7).Locked = False
    Text1(8).Locked = False
    Combo2.Locked = False
    Combo3.Locked = False
    DTPicker1.Visible = True
    DTPicker2.Visible = True
    Label13.Visible = False
    Label2.Visible = False
        
    Text1(1).BackColor = &H80000005
    Text1(2).BackColor = &H80000005
    Text1(3).BackColor = &H80000005
    Text1(4).BackColor = &H80000005
    Text1(5).BackColor = &H80000005
    Text1(6).BackColor = &H80000005
    Text1(7).BackColor = &H80000005
    Text1(8).BackColor = &H80000005
    Combo2.BackColor = &H80000005
    Combo3.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.MNU3.Enabled = False
    Me.MNU23.Enabled = True
    Me.MNU28.Enabled = True
    Data1.Enabled = False

End Sub
Private Sub Save()      '保存修改
    Text1(1).Locked = True
    Text1(2).Locked = True
    Text1(3).Locked = True
    Text1(4).Locked = True
    Text1(5).Locked = True
    Text1(6).Locked = True
    Text1(7).Locked = True
    Text1(8).Locked = True
    Combo2.Locked = True
    Combo3.Locked = True
    DTPicker1.Visible = False
    DTPicker2.Visible = False
    Label13.Visible = True
    Label2.Visible = True
        
    Text1(1).BackColor = &H8000000F
    Text1(2).BackColor = &H8000000F
    Text1(3).BackColor = &H8000000F
    Text1(4).BackColor = &H8000000F
    Text1(5).BackColor = &H8000000F
    Text1(6).BackColor = &H8000000F
    Text1(7).BackColor = &H8000000F
    Text1(8).BackColor = &H8000000F
    Combo2.BackColor = &H8000000F
    Combo3.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.MNU3.Enabled = True
    Me.MNU23.Enabled = False
    Me.MNU28.Enabled = False
    Data1.Enabled = True
    
End Sub
123

⌨️ 快捷键说明

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