frmmdi.frm

一个功能完善,界面比较精美的酒店管理系统

      End
      Begin VB.Menu mnuUtiNotepad 
         Caption         =   "Notepad"
      End
   End
   Begin VB.Menu set 
      Caption         =   "Settings"
      Begin VB.Menu sb 
         Caption         =   "Side Bar"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuLogOff 
         Caption         =   "&Log Off"
      End
      Begin VB.Menu s 
         Caption         =   "-"
      End
      Begin VB.Menu appskin 
         Caption         =   "Application Skin"
         Begin VB.Menu def 
            Caption         =   "Default"
         End
         Begin VB.Menu xpblue 
            Caption         =   "XP Blue"
         End
         Begin VB.Menu winclassic 
            Caption         =   "Win Classic"
         End
         Begin VB.Menu macgrey 
            Caption         =   "Mac Grey"
         End
         Begin VB.Menu liviolet 
            Caption         =   "Light Violet"
         End
         Begin VB.Menu lightbr 
            Caption         =   "Light Brown"
         End
         Begin VB.Menu coolgreen 
            Caption         =   "Cool Green"
         End
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "About"
      End
   End
   Begin VB.Menu mnuExit 
      Caption         =   "Exit"
   End
End
Attribute VB_Name = "frmMDI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim c As Integer
Dim prevHour As Byte

Private Sub adduser_Click()
frmAddUser.Show 1
End Sub

Private Sub allemp_Click()
DataReport1.Show
End Sub

Private Sub backup_Click()
frmBackup.Show 1
End Sub

Private Sub comp_Click()
frmCompany.Show 1
End Sub

Private Sub coolgreen_Click()
Call select_color_type(3)
sys_color = "3"

End Sub

Private Sub dai_Click()
frmReport.Show 1
End Sub

Private Sub def_Click()
Call select_color_type(0)
sys_color = "0"

End Sub

Private Sub id_Click()
rptEmpReport.Show 1
End Sub

Private Sub lightbr_Click()
Call select_color_type(5)
sys_color = "5"

End Sub

Private Sub liviolet_Click()
Call select_color_type(4)
sys_color = "4"

End Sub

Private Sub macgrey_Click()
Call select_color_type(1)
sys_color = "1"

End Sub

Private Sub MDIForm_Load()
StatusBar.Panels(2).Text = Format(Date, "long date")
Connect
With RS_Company
Label1.Caption = .Fields(0)
Label2.Caption = .Fields(1)
Label3.Caption = .Fields(2)
Label4.Caption = "You are Logged in as  : - " & UserName
Label5.Caption = Now
frmsidebar.Show
frmTip.Show
End With
loadTicker
End Sub


Private Sub mnuEmpAdd_Click()
frmEmployeeAdd.Show 1
End Sub

Private Sub mnuEmpDelete_Click()
frmDeleteEmployee.Show 1
End Sub

Private Sub mnuEmpEdit_Click()
frmEditemployee.Show 1
End Sub

Private Sub mnuExit_Click()
If MsgBox("Are You Sure ?", vbYesNo + vbInformation, "Warning") = vbYes Then
    End
    Unload frmSYSTRAYICON
End If
With RS_Userlog
       .AddNew
       .Fields(0) = UserName
       .Fields(1) = "Log Out"
       .Fields(2) = Date
       .Fields(3) = Time
        .Fields(4) = "Successful"
       .Update
    End With

End Sub

Private Sub mnuGuCheckIn_Click()
frmcheckIn.Show 1
End Sub

Private Sub mnuGuCheckOut_Click()
frmCheckOut.Show 1
End Sub




Private Sub mnuGuEdit_Click()
frmEditGuest.Show 1
End Sub

Private Sub mnuHelpAbout_Click()
Forms (12)
End Sub

Private Sub mnuLogOff_Click()
If MsgBox("Are you sure you want to Log Off?", vbYesNo) = vbYes Then
Unload Me
Load fmLogin
fmLogin.Show
Else
Exit Sub
End If
End Sub

Private Sub mnuSrchEmp_Click()
frmSearchEmp.Show 1
End Sub

Private Sub mnuSrchGuest_Click()
frmSearchGuest.Show 1
End Sub

Private Sub mnuUtiCal_Click()
On Error GoTo errHandle
    Dim a As Double
    a = Shell("calc.exe", vbNormalFocus)
    Exit Sub
errHandle:
    MsgBox "Unable to run Calculator Utility on your computer", vbInformation, "Error in opening!!!"
    Resume Next
End Sub



Private Sub mnuUtiChangeCharges_Click()
frmChangeRate.Show 1
End Sub

Private Sub mnuUtiChangePass_Click()
frmChangePassword.Show 1
End Sub

Private Sub mnuUtiNotepad_Click()
On Error GoTo errHandle
    Dim a As Double
    a = Shell("notepad.exe", vbNormalFocus)
    Exit Sub
errHandle:
    MsgBox "Unable to run Notepad Utility on your computer", vbInformation, "Error in opening!!!"
    Resume Next
End Sub

Private Sub mnuViewCharges_Click()
frmCharges.Show 1
End Sub

Private Sub mnuViewStatus_Click()
frmStatus.Show 1
End Sub

Private Sub pay_Click()
frmPayroll.Show 1
End Sub

Private Sub payment_Click()
frmGuestPayment.Show 1
End Sub

Private Sub res_Click()
frmreservations.Show 1
End Sub

Private Sub sb_Click()
If frmsidebar.Visible = True Then
frmsidebar.Visible = False
ElseIf frmsidebar.Visible = False Then
frmsidebar.Visible = True
End If
End Sub

Private Sub Timer1_Timer()
StatusBar.Panels(4).Text = Right(StatusBar.Panels(4).Text, Len(StatusBar.Panels(4).Text) - 1) & Left(StatusBar.Panels(4).Text, 1)
End Sub

Private Sub viewus_Click()
frmViewUsers.Show 1
End Sub

Private Sub winclassic_Click()
Call select_color_type(6)
sys_color = "6"

End Sub

Private Sub xpblue_Click()
Call select_color_type(2)
sys_color = "2"
End Sub
Private Sub loadTicker()
Dim tickSQL As String
tickSQL = " SELECT msgTitle,msgText FROM Ticker "

'Dim rs_ticker As Recordset
'RS_ticker.Open tickSQL, cnn, adOpenDynamic, adLockPessimistic
'First load an array of labels
Dim i As Integer
'Assign recordset to labels
i = 0
While Not RS_ticker.EOF
    On Error Resume Next
    lblTicker(i).Container = frmTick
    lblTicker(i).Visible = False
    lblTicker(i).Caption = RS_ticker("msgTitle") & vbCrLf & RS_ticker("msgText")
    i = i + 1
    Load lblTicker
    RS_ticker.MoveNext
Wend
'RS_ticker.Close
'Set RS_ticker = Nothing
tmrTicker.Enabled = True
c = 0
End Sub
Private Sub tmrTicker_Timer()
Dim currMin As Byte
currMin = Minute(Now())
If currMin > prevmin Then 'Refreshes every hour
    prevmin = currMin
    destroyTicker
    loadTicker
End If
moveTicker 15
End Sub
Private Sub moveTicker(ByVal amt As Integer)
lblTicker(c).ZOrder vbBringToFront
lblTicker(c).Visible = True
lblTicker(c).Top = lblTicker(c).Top - amt

If lblTicker(c).Top < 0 - lblTicker(c).Height Then
    'hide the current lbl
    lblTicker(c).Visible = False
    c = c + 1
    If c > lblTicker.UBound Then
        c = 0
    End If
    tickerStart
End If
End Sub
Private Sub destroyTicker()
Dim i As Integer
For i = lblTicker.LBound To lblTicker.UBound
    'Suppose to free memory
    If i <> 0 Then
        Unload lblTicker(i)
    End If
Next i
End Sub
Private Sub tickerStart()
'Starts the news ticker
'Set the first ticker visible and position on top of frame
lblTicker(c).Visible = True
'lblTicker(c).Top = frmTick.Height
lblTicker(c).Left = 120
tmrTicker.Enabled = True
End Sub

Private Sub tickerStop()
'Stops the news ticker
tmrTicker.Enabled = False
destroyTicker
End Sub