📄 hjsz.frm

📁 小型酒店管理系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
       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 DBGrid1_Error(ByVal DataError As Integer, Response As Integer)
    MsgBox DBGrid1.ErrorText, vbCritical, "错误信息"
    DataError = 0
    Response = 0
End Sub

Private Sub List1_DblClick()
    DBGrid1.SetFocus
End Sub

Private Sub LIST1_LostFocus()
    List1.Visible = False
    DBGrid1.Columns(DBGrid1.Col) = List1.Text
    DBGrid1.Refresh
End Sub

Private Sub DBGrid1_ButtonClick(ByVal ColIndex As Integer)
    List1.Clear
    If ColIndex = 0 Then
       List1.DataField = "楼层"
       List1.AddItem "一楼"
       List1.AddItem "二楼"
       List1.AddItem "三楼"
       List1.AddItem "四楼"
       List1.AddItem "五楼"
       List1.AddItem "六楼"
       List1.AddItem "七楼"
       List1.AddItem "八楼"
    End If
    If ColIndex = 2 Then
       List1.DataField = "类型"
       List1.AddItem "标准间"
       List1.AddItem "双人间"
       List1.AddItem "三人间"
       List1.AddItem "豪华单间"
       List1.AddItem "总统套房"
    End If
    If ColIndex = 3 Then
       List1.DataField = "房态"
       List1.AddItem "空房"
       List1.AddItem "在住"
       List1.AddItem "走房"
       List1.AddItem "维修"
    End If
    List1.Text = DBGrid1.Columns(ColIndex)
    List1.Move DBGrid1.Columns(ColIndex).left + DBGrid1.left, DBGrid1.RowTop(DBGrid1.Row) + DBGrid1.top + DBGrid1.RowHeight, DBGrid1.Columns(ColIndex).Width
    List1.Visible = True
    List1.SetFocus
    
End Sub

Private Sub Form_Load()
    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()
    If Data1.Recordset.RecordCount > 0 Then
       HJSZPREVIEW.Show vbModal
       Else
         MsgBox "无房间设置信息!", vbInformation, "提示信息"
    End If
End Sub

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

End Sub

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


Private Sub MNU21_Click()
    On Error GoTo ERROR
    If DBGrid1.DataChanged Then
       Data1.UpdateRecord
    End If
    Data1.Recordset.AddNew
    DD = Data1.Recordset("ID")
    Data1.Recordset.Update
    Data1.Recordset.FindFirst ("ID=" & DD)
    Chang
    Exit Sub
    
ERROR:
    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()     ' 删除记录
    On Error GoTo EXITSUB
    
    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
            Data1.Recordset.Delete
            If Not Data1.Recordset.EOF Then
               Data1.Recordset.MoveNext
               If Data1.Recordset.EOF Then
                  If Data1.Recordset.RecordCount > 0 Then Data1.Recordset.MoveLast
               End If
               Else
                 If Data1.Recordset.RecordCount > 0 Then Data1.Recordset.MoveLast
            End If
       End If
    End If
    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 MNU23_Click()
    On Error GoTo EXITSUB
    
    MYID = Data1.Recordset("房号")
    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()
    Chang
End Sub

Private Sub MNU28_Click()
    On Error GoTo EXITSUB
    
    If Data1.Recordset.RecordCount > 0 Then Data1.UpdateRecord
    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
              Data1.UpdateControls
              Resume Next
         End If
    End If
    
End Sub

Private Sub MNU3_Click()
    If Data1.Recordset.RecordCount = 0 Then
       MsgBox "无房间信息可查!", vbInformation, "提示信息"
       Exit Sub
    End If
    Load FJCX
    FJCX.Show vbModal
    Data1.Recordset.FindFirst ("房号=" & FJCX.INTFH)
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()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    STRVALID = "0123456789"
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
    
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    STRVALID = "0123456789."
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
    
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    STRVALID = "0123456789."
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
    
End Sub

Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
End Sub
Private Sub Text3_GotFocus()
    Text3.SelStart = 0
    Text3.SelLength = Len(Text3.Text)
End Sub

Private Sub Text2_Validate(Cancel As Boolean)
    If IsNumeric(Text2.Text) Then Text2.Text = FormatCurrency(Text2.Text, , vbTrue)
    
End Sub
Private Sub Text3_Validate(Cancel As Boolean)
    If IsNumeric(Text3.Text) Then Text3.Text = Format(Text3.Text, "0.00%")

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button
        Case "打印"
            MNU13_Click
        Case "预览"
            MNU12_Click
        Case "新增"
            MNU21_Click
        Case "取消"
            MNU23_Click
        Case "修改"
            MNU26_Click
        Case "保存"
            MNU28_Click
        Case "删除"
            MNU22_Click
        Case "查看"
            MNU3_Click
        Case "计算器"
            MNU4_Click
        Case "帮助"
            MNU51_Click
        Case "退出"
            Unload Me
 
    End Select
End Sub

Private Sub Chang()      '可修改状态
    '置有效或无效菜单
    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
    DBGrid1.AllowUpdate = True
    DBGrid1.Columns(0).Button = True
    DBGrid1.Columns(2).Button = True
    DBGrid1.Columns(3).Button = True
    DBGrid1.BackColor = &H80000005
End Sub
Private Sub Save()      '保存修改
    '置有效或无效菜单
    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
    DBGrid1.AllowUpdate = False
    DBGrid1.Columns(0).Button = False
    DBGrid1.Columns(2).Button = False
    DBGrid1.Columns(3).Button = False
    DBGrid1.BackColor = &HE0E0E0
End Sub
上一页 12
⌨️ 快捷键说明

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