📄 fzfsk.frm

📁 酒店系统源码。为了学习和研究软件内含的设计思想和原理
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
    Data2.Refresh

End Sub

Private Sub DBGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
    If Button = vbRightButton Then
       Me.PopupMenu POP1
    End If

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 DBCombo1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then SendKeys "{TAB}"

End Sub

Private Sub DTPicker1_Validate(Cancel As Boolean)
    Label3.Caption = Format(DTPicker1.Value, "LONG DATE")
End Sub

Private Sub Form_Activate()
    If Data1.Recordset.RecordCount = 0 Then MNU21_Click
    Label3.Caption = Format(Label3.Caption, "LONG DATE")
    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
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{TAB}"

End Sub

Private Sub Form_Load()
    Data1.DatabaseName = App.Path & "\data\jdgl.mdb"
    Data2.DatabaseName = App.Path & "\data\jdgl.mdb"
    Data1.Refresh
    Data2.Refresh

    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECHJZT = DATJDGL.OpenRecordset("房间状态", dbOpenDynaset)
    Set RECKRZD = DATJDGL.OpenRecordset("客人帐单", dbOpenDynaset)
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()
    FZFSKPREVIEW.Show vbModal
End Sub

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

Private Sub MNU16_Click()     ' 退出模块
    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.Recordset.AddNew
    Data1.Recordset("班次") = frmLogin.CZYBC
    Text6.Text = RECNO
    DTPicker1.Value = Now
    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 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
       Combo4.Text = YDRZ.STRYD3
       Combo3.Text = YDRZ.STRYD4
       Text4.Text = YDRZ.STRYD5
       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 MNU26_Click()
    If Data1.Recordset.RecordCount > 0 Then Chang

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 Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then SendKeys "{TAB}"
    
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 Text4_GotFocus()
    Text4.SelStart = 0
    Text4.SelLength = Len(Text4.Text)
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then SendKeys "{TAB}"

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 SendKeys "{TAB}"
    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 Text7_GotFocus()
    Text7.SelStart = 0
    Text7.SelLength = Len(Text7.Text)
    
End Sub

Private Sub TEXT7_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then SendKeys "{TAB}"

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
    Text4.Locked = False
    Text5.Locked = False
    Text7.Locked = False
    Combo1.Locked = False
    DBCombo1.Locked = False
    Combo3.Locked = False
    DTPicker1.Visible = True
    Label3.Visible = False
        
    Text1(8).BackColor = &H80000005
    Text2.BackColor = &H80000005
    Text4.BackColor = &H80000005
    Text5.BackColor = &H80000005
    Text7.BackColor = &H80000005
    Combo1.BackColor = &H80000005
    Combo3.BackColor = &H80000005
    DBCombo1.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(8).Locked = True
    Text2.Locked = True
    Text4.Locked = True
    Text5.Locked = True
    Text7.Locked = True
    Combo1.Locked = True
    DBCombo1.Locked = True
    Combo3.Locked = True
    DTPicker1.Visible = False
    Label3.Visible = True
        
    Text1(8).BackColor = &H8000000F
    Text2.BackColor = &H8000000F
    Text4.BackColor = &H8000000F
    Text5.BackColor = &H8000000F
    Text7.BackColor = &H8000000F
    Combo1.BackColor = &H8000000F
    Combo3.BackColor = &H8000000F
    DBCombo1.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
上一页 1 23
💿 文件大小 1248 K
👤 上传用户 fengkuangyidao
📂 所属分类酒店行业
🏷️ 相关标签

#源码 #软件 #设计思想
⌨️ 快捷键说明

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