frmmain.frm

星级酒店管理系统VB源代码

            Key             =   "Italic"
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":1AF4
            Key             =   "Underline"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":1C06
            Key             =   "Align Left"
         EndProperty
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":1D18
            Key             =   "Center"
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":1E2A
            Key             =   "Align Right"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar tbToolBar 
      Align           =   1  'Align Top
      Height          =   360
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   4680
      _ExtentX        =   8255
      _ExtentY        =   635
      ButtonWidth     =   609
      ButtonHeight    =   582
      Style           =   1
      ImageList       =   "imlToolbarIcons(0)"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   17
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.Visible         =   0   'False
            Key             =   "新建"
            Object.ToolTipText     =   "新建"
            ImageKey        =   "New"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.Visible         =   0   'False
            Key             =   "打开"
            Object.ToolTipText     =   "打开"
            ImageKey        =   "Open"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.Visible         =   0   'False
            Key             =   "保存"
            Object.ToolTipText     =   "保存"
            ImageKey        =   "Save"
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "打印"
            Object.ToolTipText     =   "打印"
            ImageKey        =   "Print"
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "剪切"
            Object.ToolTipText     =   "剪切"
            ImageKey        =   "Cut"
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "复制"
            Object.ToolTipText     =   "复制"
            ImageKey        =   "Copy"
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "粘贴"
            Object.ToolTipText     =   "粘贴"
            ImageKey        =   "Paste"
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "粗体"
            Object.ToolTipText     =   "粗体"
            ImageKey        =   "Bold"
         EndProperty
         BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "斜体"
            Object.ToolTipText     =   "斜体"
            ImageKey        =   "Italic"
         EndProperty
         BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "下划线"
            Object.ToolTipText     =   "下划线"
            ImageKey        =   "Underline"
         EndProperty
         BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "左对齐"
            Object.ToolTipText     =   "左对齐"
            ImageKey        =   "Align Left"
            Style           =   2
         EndProperty
         BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "置中"
            Object.ToolTipText     =   "置中"
            ImageKey        =   "Center"
            Style           =   2
         EndProperty
         BeginProperty Button17 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "右对齐"
            Object.ToolTipText     =   "右对齐"
            ImageKey        =   "Align Right"
            Style           =   2
         EndProperty
      EndProperty
      BorderStyle     =   1
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileClose 
         Caption         =   "关闭(&C)"
      End
      Begin VB.Menu mnuFileBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileSave 
         Caption         =   "保存(&S)"
      End
      Begin VB.Menu mnuFileSaveAs 
         Caption         =   "另存为(&A)..."
      End
      Begin VB.Menu mnuFileSaveAll 
         Caption         =   "全部保存(&L)"
      End
      Begin VB.Menu mnuFileBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileProperties 
         Caption         =   "属性(&I)"
      End
      Begin VB.Menu mnuFileBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFilePageSetup 
         Caption         =   "页面设置(&U)..."
      End
      Begin VB.Menu mnuFilePrintPreview 
         Caption         =   "打印预览(&V)"
      End
      Begin VB.Menu mnuFilePrint 
         Caption         =   "打印(&P)..."
      End
      Begin VB.Menu mnuFileBar3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileSend 
         Caption         =   "发送(&D)..."
      End
      Begin VB.Menu mnuFileBar4 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuEditCancel 
         Caption         =   "撤消"
      End
      Begin VB.Menu mnuEditCut 
         Caption         =   "剪切(&T)"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuEditCopy 
         Caption         =   "复制(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "粘贴(&P)"
         Shortcut        =   ^V
      End
      Begin VB.Menu mnuEditRefresh 
         Caption         =   "刷新"
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "工具(&T)"
      Begin VB.Menu mnuToolsDocuments 
         Caption         =   "文档归档"
      End
      Begin VB.Menu mnuToolsRead 
         Caption         =   "阅读文档"
      End
      Begin VB.Menu mnuToolsReports 
         Caption         =   "制作报表"
      End
      Begin VB.Menu mnuToolsBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuToolsAppointment 
         Caption         =   "我的约会（会议）"
      End
      Begin VB.Menu mnuToolsProject 
         Caption         =   "项目信息"
      End
      Begin VB.Menu mnuToolsContact 
         Caption         =   "我的名片夹"
      End
      Begin VB.Menu mnuToolsOptions 
         Caption         =   "选项(&O)..."
      End
      Begin VB.Menu mnuToolsMsg 
         Caption         =   "发送消息"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuToolsDiskSpace 
         Caption         =   "磁盘空间"
      End
      Begin VB.Menu mnuHelpContents 
         Caption         =   "目录(&C)"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hWnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Dim DraggedDate As Date
Public AutoSaveTime As Date
Public cn As New ADODB.Connection

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    
    If Not (Me.ActiveForm Is Nothing) Then
        Unload Me.ActiveForm
    End If
    Select Case Item.Text
        Case "文档归档"
            mnuToolsDocuments_Click
        Case "文档阅读"
            mnuToolsRead_Click
        Case "项目信息"
            mnuToolsProject_Click
        Case "我的约会"
            mnuToolsAppointment_Click
        Case "我的名片"
            mnuToolsContact_Click
        Case Else
    End Select
    
End Sub

Private Sub MDIForm_Load()
    
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    
    MonthView1.Value = Date
    Call EverydayTips
    
    DEDocuments.rs自动归档表.Open
    AutoSaveTime = DEDocuments.rs自动归档表.Fields("最后归档时间")
    
    Picture1.AutoSize = False
    Picture1.Align = vbAlignLeft
    Picture1.Width = Me.Width / 7
    Picture2.AutoSize = False
    Picture2.Align = vbAlignLeft
    Picture2.Width = Me.Width * 6 / 7
    
    ListView1.ColumnHeaders.Clear
    ListView1.ListItems.Clear
    ListView1.View = lvwIcon
    
    ListView1.Font.Name = "宋体"
    ListView1.Font.Size = 9
    
    ListView1.Height = Picture1.Height
    ListView1.Width = Picture1.Width
    ListView1.BackColor = Picture1.BackColor
    
    ListView1.ListItems.Add , , "文档归档", 1
    ListView1.ListItems.Add , , "文档阅读", 1
    ListView1.ListItems.Add , , "我的约会", 1
    ListView1.ListItems.Add , , "我的名片", 1
    ListView1.ListItems.Add , , "项目信息", 1
    
    tvwCRefresh
End Sub
Private Sub EverydayTips()
    Dim td As Variant
    Dim tips As String
    tips = "今天是："
    DEDocuments.rs重要信息表.Open
    
    If DEDocuments.rs重要信息表.EOF Then
        tips = "您应该考虑备份的日子了，"
    Else
        tips = "您应该考虑备份的日子了。另外，"
        Do While Not DEDocuments.rs重要信息表.EOF
            td = DEDocuments.rs重要信息表.Fields("日期").Value
            If Month(td) = Month(Date) And Day(td) = Day(Date) Then
                tips = tips & DEDocuments.rs重要信息表.Fields("类别").Value & "；"
                tips = tips & DEDocuments.rs重要信息表.Fields("说明").Value
            End If
            DEDocuments.rs重要信息表.MoveNext
        Loop
    End If
    tips = tips & "您可要重视啊！不要忘记哦！"
    
    sbStatusBar(0).Panels(1).Text = tips
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub mnuEditCancel_Click()
    SendKeys "^{Z}"
End Sub

Private Sub mnuEditRefresh_Click()
    If Me.ActiveControl Is Picture1 Then
        Me.MSHFlexGrid1.Refresh
        Me.tvwC.Refresh
    End If
    
End Sub

Private Sub mnuToolsAppointment_Click()
    Dim f As New frmAppointment
    Me.Picture2.Visible = False
    f.Show
    
End Sub

Private Sub mnuToolsContact_Click()
    Dim f As New frmContact
    Me.Picture2.Visible = False
    f.Show
End Sub

Private Sub mnuToolsDiskSpace_Click()
    MsgBox FreeSpace()
End Sub

Private Sub mnuToolsDocuments_Click()
    Dim f As New frmDocuments
    
    Me.Picture2.Visible = False
    
    f.Show
End Sub


Private Sub mnuToolsMsg_Click()
    MessengerOrig.Show (1)
End Sub

Private Sub mnuToolsProject_Click()
    Dim f As New frmProject
    Me.Picture2.Visible = False
    f.Show
End Sub

Private Sub mnuToolsRead_Click()
    Me.Picture2.Visible = False
    frmRead.Adodc1.ConnectionString = "DSN=DM;UID=;PWD=;"
    frmRead.Show

End Sub

Private Sub mnuToolsReports_Click()
    frmReports.Show
End Sub

Private Sub MonthView1_DateDblClick(ByVal DateDblClicked As Date)
    Dim f As New frmAppointment
    Load f
    f.txtFields(3).Text = DateDblClicked
    Me.Picture2.Visible = False
    f.Show