mdiform1.frm

档案管理系统源码VB档案管理系统源码VB

      End
      Begin VB.Menu MnuDataPathDisplay 
         Caption         =   ""
      End
      Begin VB.Menu MnuWordPath 
         Caption         =   "配置Word文档保存路径[&D]"
         Shortcut        =   ^D
         Visible         =   0   'False
      End
   End
   Begin VB.Menu MnuHelp 
      Caption         =   "帮助中心^&H)"
      Begin VB.Menu MnuTip 
         Caption         =   "&D 每日一贴"
         Shortcut        =   {F1}
      End
      Begin VB.Menu step2 
         Caption         =   "-"
      End
      Begin VB.Menu MnuWxy 
         Caption         =   "&A 关于系统"
         Shortcut        =   {F12}
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************
'**  Function Declarations: From Wenxingyuan
Dim MouseD As Boolean, Oldx As Single, Oldy As Single
Private Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
Dim showT As Boolean

Private Sub MDIForm_Activate()

If showT = True Then Exit Sub

Dim Ltp As Long
Ltp = GetSetting(App.EXEName, "Options", "Show Tips at Startup", 1)
If Ltp = 1 Then
   frmTip.Show
End If

  showT = True
  

End Sub

Private Sub MDIForm_Load()

frmMain.MousePointer = 11
Dim Ltp As Long
'frmMain.WindowState = GetSetting(App.EXEName, "Windows", "Windows Status", 1)
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)

'配置图片
StatusBar.Panels.Item(3).Text = "日期:" & Format(Date, "Long Date")
'frmMain.Caption = TempArray(0) + "-档案管理系统"
frmMain.StatusBar.Panels.Item(6).Text = "制作单位：" + TempArray(0)
frmMain.StatusBar.Panels.Item(6).ToolTipText = "欢迎使用本软件"
frmMain.MousePointer = 0
On Error Resume Next
frmMain.Picture = LoadPicture(TempArray(5))
frmMain.StatusBar.Panels.Item(2).Text = "准备就绪..."
showT = False

'权限控制
Select Case PurView
   Case "只能添加"
     MnuCompany.Enabled = False
     MnuEmploy.Enabled = False
   Case "不能修改"
     MnuCompany.Enabled = False
     MnuEmploy.Enabled = False
   Case "可以修改"
     MnuEmploy.Enabled = False
   Case "超级权限"
     '没有权限限制
End Select

'显示路径
 MnuDataPathDisplay.Caption = "当前数据库路径：" & ConData
 
Exit Sub


PhotoValible:
  MsgBox "桌面图片配置有错误,请重新配置桌面!", vbOKOnly + 16, "警告!"
  frmMain.MousePointer = 0
  Exit Sub
End Sub

Private Sub MDIForm_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

  If Button = 2 Then '右键按下时
     PopupMenu MnuSystem
  End If
  
End Sub

Private Sub MDIForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If frmMain.StatusBar.Panels.Item(2).Text = "待命状态..." Then
   Exit Sub
   Else
   frmMain.StatusBar.Panels.Item(2).Text = "待命状态..."
End If

End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim SureQ As Integer
SureQ = MsgBox("真的退出该系统吗(Y/N)？    ", vbYesNo + 32, "请确认...")
  If SureQ = 6 Then
     Cancel = 0
     Else
     Cancel = -1
  End If
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    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
    'SaveSetting App.EXEName, "Windows", "Windows Status", frmMain.WindowState
    
End Sub


Private Sub MnuCompany_Click()

 Me.MousePointer = 11
 GetStatus "公司信息配置"
 If ConfigForm.Visible = True Then
    ConfigForm.SetFocus
 Else
    ConfigForm.Show
 End If
 Me.MousePointer = 0
 
End Sub

Private Sub MnuEmploy_Click()

 Me.MousePointer = 11
 GetStatus "操作员配置"
 If frmOperator.Visible = True Then
    frmOperator.SetFocus
 Else
    frmOperator.Show
 End If
 Me.MousePointer = 0
 
End Sub

Private Sub MnuExi_Click()
 
 GetStatus "关闭系统"
 Unload Me
 
End Sub

Private Sub MnuGuestManager_Click()

 GetStatus "档案添加、删除、修改、查询"
 
End Sub

Private Sub MnuGuestType_Click()
 
 frmMain.MousePointer = 11
 GetStatus "档案类型有：公文、原始材料"
 frmCatalog.Show 1
 frmMain.MousePointer = 0
  
End Sub

Private Sub Mnuhelp_Click()

GetStatus "配置桌片图片、操作员、关于信息"

End Sub

Private Sub MnuNetData_Click()

 frmMain.MousePointer = 11
  NetData.Show 1
 frmMain.MousePointer = 0
 
End Sub

Private Sub MnuSearchGuest_Click()

 frmMain.MousePointer = 11
  If frmManager.Visible = True Then
     frmManager.SetFocus
   Else
     frmManager.Show
  End If
 frmMain.MousePointer = 0
 
End Sub

Private Sub MnuTip_Click()

frmMain.MousePointer = 11
GetStatus "系统的使用技巧与帮助"
If frmTip.Visible = True Then
  frmTip.SetFocus
  frmMain.MousePointer = 0
  Exit Sub
End If
SaveSetting App.EXEName, "Options", "Show Tips at Startup", -1

If frmTip.Visible = True Then
   frmTip.SetFocus
End If
frmTip.Show
frmMain.MousePointer = 0

End Sub

Private Sub MnuWxy_Click()

 frmMain.MousePointer = 11
 GetStatus "关于系统描述"
 frmAbout.Show 1
 frmMain.MousePointer = 0
 
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)

  Select Case Button.Key
    
    Case "Manager"
      GetStatus "目录添加、删除、文件添加、修改、删除"
      Call MnuSearchGuest_Click
    Case "Content"
      GetStatus "目录添加、删除"
      Call MnuGuestType_Click
    Case "Add"
      GetStatus "在此目录下添加新档案"
      Call frmManager.MnuAddFile_Click
    Case "Modify"
      GetStatus "修改选定的档案"
      Call frmManager.MnuModifyFile_Click
    Case "Delete"
      GetStatus "删除选定的档案"
      Call frmManager.MnuDeleteFile_Click
    Case "Search"
      GetStatus "搜索档案仓库，查找匹配档案"
      Call frmManager.MnuSearchFile_Click
    Case "Help"
      GetStatus "系统操作手册"
      Call MnuTip_Click
    Case "Exit"
      GetStatus "退出档案管理系统"
      Call MnuExi_Click
  End Select
   
End Sub