frmmain2.frm

一个实用的房产信息管理系统

   Begin VB.Menu mnuRelate 
      Caption         =   "【相关信息&A】"
      Begin VB.Menu mnuRelateFamily 
         Caption         =   "家庭情况[&F]"
      End
      Begin VB.Menu mnu31 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRelateHouse 
         Caption         =   "住房情况[&H]"
      End
      Begin VB.Menu mnu1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuJiangL 
         Caption         =   "奖励情况"
      End
      Begin VB.Menu mnu2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuBut 
         Caption         =   "补贴情况"
      End
   End
   Begin VB.Menu mnuData 
      Caption         =   "【数据管理&D】 "
      Begin VB.Menu mnuDataRenshi 
         Caption         =   "人事处数据校核[&R]"
      End
      Begin VB.Menu mnu41 
         Caption         =   "-"
      End
      Begin VB.Menu mnuDataCaiwu 
         Caption         =   "财务处数据校核[&C]"
      End
   End
   Begin VB.Menu MNUMULT 
      Caption         =   "【多媒体演示&M】"
      Begin VB.Menu MNUCOMPEL 
         Caption         =   "Compel演示系统[&C]"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "【帮助&H】"
      Begin VB.Menu mnuHelpSoftware 
         Caption         =   "使用说明[&N]"
      End
      Begin VB.Menu mnu51 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpVersion 
         Caption         =   "关于……"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Word As Object
Dim pic As String
Private Sub Form_Load()
On Error Resume Next
Line2.X1 = 0
Line2.X2 = Screen.Width
Open App.Path + "\PIC.TXT" For Input As #1
Input #1, pic
Close #1
frmMain.Picture = LoadPicture(pic)
Frmflash.Timer1.Enabled = False
Unload Frmflash
FlatBar1.SetToolBAar Toolbar1, 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
'
End Sub

Private Sub mnuBaseInput_Click()
frmBaseInput.Show vbModal
End Sub

Private Sub mnuBaseQuery_Click()
frmBaseQuery.Show vbModal
End Sub

Private Sub MNUBEI_Click()
 On Error Resume Next
 Dim sFile As String
    With CDlog1
        'To Do
        '设置 common dialog 控件的标志和属性
        .Filter = "BMP图像格式(*.BMP)|*.BMP|JPG图像格式" & _
                  "(*.JPG)|*.JPG|wmf图像格式(*.wmf)|*.wmf|所有文件(*.*)|*.*"
' 指定缺省的过滤器
        .FilterIndex = 2
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
frmMain.Picture = LoadPicture(sFile)
Open App.Path + "\PIC.TXT" For Output As #1
Write #1, sFile
Close #1
MNUCANCEL.Checked = False
End Sub

Private Sub mnuBut_Click()
frmQuBuT.Show vbModal
End Sub

Private Sub MNUCOMPEL_Click()
On Error GoTo ERR
 Dim sFile As String
    With CDlog1
        'To Do
        '设置 common dialog 控件的标志和属性
        .Filter = "多媒体演示格式(*.cpl)|*.cpl"
' 指定缺省的过滤器
        .FilterIndex = 1
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
Shell App.Path + "\compel\compel " + sFile, vbNormalFocus '       , vbMaximizedFocus
Exit Sub
ERR:
MsgBox ERR.Description, vbCritical, "出错提示"
End Sub

Private Sub mnuHelpSoftware_Click()
Dim TT As String
Dim X
TT = App.Path & "\NOTE.TXT"
X = Shell("Notepad " + TT, 1)

End Sub

Private Sub mnuHelpVersion_Click()
Frmhelp.Show 1
End Sub

Private Sub mnuJiangL_Click()
frmQuJiangL.Show vbModal
End Sub

Private Sub MNUOPEN_Click()
 Dim sFile As String
    With CDlog1
        'To Do
        '设置 common dialog 控件的标志和属性
        .Filter = "文本文件(*.txt)|*.txt|Word文档" & _
                  "(*.doc)|*.doc|Excel文档(*.xls)|*.xls"
' 指定缺省的过滤器
        .FilterIndex = 2
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With

'文本文档
If Right(Trim(sFile), 3) = "txt" Then
Dim X
X = Shell("Notepad " + sFile, 1)
End If

'Word文档
If Right(Trim(sFile), 3) = "doc" Then
Set Word = CreateObject("Word.BASIC")
With Word
     .FILEOPEN sFile
     .APPSHOW
End With
Set Word = Nothing
End If

'EXCEL文档
If Right(Trim(sFile), 3) = "xls" Then
Dim Excel As Object
Dim WorkSheet As Object
Dim WorkBook As Object
Set Excel = CreateObject("Excel.application")
Excel.Workbooks.Open sFile
Set WorkBook = Excel.ActiveWorkbook
Set WorkSheet = Excel.ActiveSheet
Excel.Visible = True
WorkBook.Saved = True
Set WorkSheet = Nothing
Set WorkBook = Nothing
Set Excel = Nothing
End If
End Sub

Private Sub mnuRelateFamily_Click()
frmQuFamily.Show vbModal
End Sub

Private Sub mnuRelateHouse_Click()
frmQuZhuF.Show vbModal
End Sub

Private Sub mnuRelateHouseOld_Click()
frmGoQZF.Show vbModal
End Sub

Private Sub MNUREP_Click()
frmSystemUserModify.Show 1
End Sub

Private Sub mnuSep1_Click()
If MsgBox("确信要退出系统？", vbQuestion + vbYesNo, "退出前提示") = vbNo Then
Exit Sub
Else
Unload Me
End If

End Sub

Private Sub MNUUSER_Click()
frmSystemNewUser.Show 1
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Index
Case 1
If MsgBox("确信要退出系统？", vbQuestion + vbYesNo, "退出前提示") = vbNo Then
Exit Sub
Else
Unload Me
End If
'Unload Me
Case 3
  Shell sBuffer & "calc.exe", 1
Case 4
  Shell sBuffer & "cdplayer.exe", 1
Case 5
  Shell sBuffer & "notepad.exe", 1
Case 6
    Shell sBuffer & "Write.exe", 1
Case 7
    Shell sBuffer & "Pbrush.exe", 1
Case 8
    Shell sBuffer & "Explorer.exe", 1
Case 10
    Call mnuHelpSoftware_Click
    
End Select
End Sub