manage.frm

来自「OA编程 源代码」· FRM 代码 · 共 1,121 行 · 第 1/3 页

            
            Screen.MousePointer = 0
            
        End If
    End Select
End Sub

Private Sub menuAllSet_Click()
        FrmAllSet.Show
End Sub

Private Sub ProxyLimit_Click()
FrmProxyLimit.Show
End Sub

Private Sub WorkBook_Click()
Frmwork.Show
End Sub


'=====================MenusBar===================================

'================================================================
'加载管理系统的导航内容     2002-10-17
Private Sub mLoadNavigation()
    With VerticalMenu
        .MenuCur = 1 '导航条的默认位置
        .MenusMax = 4
        
        .MenuItemsMax = 2
        .MenuCaption = "用户管理"
        .MenuItemCur = 1
        .MenuItemCaption = "用户设置"
        Set .MenuItemIcon = ImgList.ListImages(12).Picture
        .MenuItemCur = 2
        .MenuItemCaption = "修改密码"
        Set .MenuItemIcon = ImgList.ListImages(14).Picture
                
                
        .MenuCur = 2
        .MenuItemsMax = 2
        .MenuCaption = "权限管理"
        .MenuItemCur = 1
        .MenuItemCaption = "应用权限"
        Set .MenuItemIcon = ImgList.ListImages(3).Picture
        .MenuItemCur = 2
        .MenuItemCaption = "快捷权限"
        Set .MenuItemIcon = ImgList.ListImages(8).Picture
                        
                        
        .MenuCur = 3
        .MenuItemsMax = 3
        .MenuCaption = "界面设置"
        .MenuItemCur = 1
        .MenuItemCaption = "主页风格"
        Set .MenuItemIcon = ImgList.ListImages(3).Picture
        .MenuItemCur = 2
        .MenuItemCaption = "主页工作区"
        Set .MenuItemIcon = ImgList.ListImages(8).Picture
        .MenuItemCur = 3
        .MenuItemCaption = "公告风格"
        Set .MenuItemIcon = ImgList.ListImages(7).Picture
                        
        .MenuCur = 4
        .MenuItemsMax = 4
        .MenuCaption = "栏目维护"
        .MenuItemCur = 1
        .MenuItemCaption = "栏目设置"
        Set .MenuItemIcon = ImgList.ListImages(21).Picture
        .MenuItemCur = 2
        .MenuItemCaption = "栏目权限"
        Set .MenuItemIcon = ImgList.ListImages(18).Picture
        .MenuItemCur = 3
        .MenuItemCaption = "栏目风格"
        Set .MenuItemIcon = ImgList.ListImages(7).Picture
        .MenuItemCur = 4
        .MenuItemCaption = "整理目录"
        Set .MenuItemIcon = ImgList.ListImages(8).Picture
        
        .MenuCur = 4
    End With
End Sub



Private Sub Menu_Style_Click(Index As Integer)
    Select Case Index
    Case 0
        FrmMainPage.Show
    Case 1
        FrmRightStyle.Show
    Case 3
        FrmSetNews.Show
    End Select
End Sub

Private Sub Menu_xt_Click(Index As Integer)
    Select Case Index
    Case 0
        Unload Me
        Register.Show 1
    Case 1
        FrmLicence.Show 1
    Case 3
        End
    End Select
End Sub




Private Sub Menus_Help_Click(Index As Integer)
    Select Case Index
    Case 0
        FrmAbout.Show 1
    Case 1
    End Select
End Sub

Private Sub Menus_Security_Click(Index As Integer)
    Select Case Index
    Case 0
     '应用权限
        FrmApplimit.Show
    Case 2
        FrmAllSet.Show     '快界权限
    End Select
End Sub

Private Sub Menus_User_Click(Index As Integer)
    Select Case Index
    Case 0
       frmUserMain.Show
    Case 2
        FrmPassword.Show
        FrmPassword.SetFocus
    End Select
End Sub


Private Sub Menus_xt_Click(Index As Integer)
    Dim bCancel As Boolean
    Dim YesOrNo As Integer
    
    Select Case Index
    Case 0
        YesOrNo = MsgBox("是否注销“Web管理控制台”程序？", vbYesNo + vbDefaultButton1 + vbQuestion, "提示")
        If YesOrNo = vbNo Then
            bCancel = True
        End If
        If bCancel = False Then
            Unload Me
            Register.Show 1
        End If
    Case 1
        FrmLicence.Show 1
    Case 3
        YesOrNo = MsgBox("是否退出“Web管理控制台”程序？", vbYesNo + vbDefaultButton1 + vbQuestion, "提示")
        If YesOrNo = vbNo Then
            bCancel = True
        End If
        If bCancel = False Then
            Call UnloadSkin
            End
        End If
    End Select
End Sub

Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  On Error GoTo Abort
    Select Case Button.Key
    Case "cmdlogin"
        Call Menus_xt_Click(0)
    Case "CutTxt"
        Clipboard.Clear
        Clipboard.SetText Screen.ActiveControl.SelText
        Screen.ActiveControl.SelText = ""
    Case "CopyTxt"
        Clipboard.Clear
        Clipboard.SetText Screen.ActiveControl.SelText
    Case "PasteTxt"
        Screen.ActiveControl.SelText = Clipboard.GetText()
    Case "WindowTileHorizontal"
        Me.Arrange vbTileHorizontal
    Case "WindowTileVertical"
        Me.Arrange vbTileVertical
    Case "WindowCascade"
        Me.Arrange vbCascade
    Case "WindowIcon"
        Me.Arrange vbArrangeIcons
    Case "Windowunload"
        While frmnum > 0
           Unload ActiveForm
        Wend
    Case "ShowTree"
        Call windows_Click(8)
    Case "help"
        With CommonDialog1
           '必须设置 Help 文件名。
           .HelpFile = App.Path & "\Helpfile.hlp"
           '显示目录。注意 HelpCNT 常数不是一个内部常数。
           'cdlHelpSetContents确保了只显示目录
           '(而不显示索引或查找)。
           .HelpCommand = HelpCNT Or cdlHelpSetContents
           .ShowHelp
        End With
    Case "CmdHome"
        frmBrowser.Show
    End Select
    Exit Sub

Abort:
    MousePointer = ccDefault
    Call ErrorMessage.ErrMessage
End Sub

Private Sub VerticalMenu_MenuItemClick(MenuNumber As Long, MenuItem As Long)
    Me.MousePointer = 0
    Select Case MenuNumber
    Case 1      '用户管理
        Select Case MenuItem
        Case 1
            Call Menus_User_Click(0)
        Case 2
            Call Menus_User_Click(2)
        End Select
    Case 2      '权限管理
        Select Case MenuItem
        Case 1
             Menus_Security_Click (0)
        Case 2
            Call Menus_Security_Click(2)
        End Select
    Case 3
        Select Case MenuItem
        Case 1
            Call Menu_Style_Click(0)
        Case 2
            Call Menu_Style_Click(1)
        Case 3
            Call Menu_Style_Click(3)
        End Select
    Case 4   '栏目设置
        Select Case MenuItem
        Case 1
            Menu_LM_Click (0)
        Case 2
            Menu_LM_Click (1)
        Case 3
            Menu_LM_Click (2)
        Case 4
            Menu_LM_Click (4)
        End Select
    End Select
End Sub




'=========================== SplitBar ====================================

'==============================================================
'按分割符时的操作         2002-10-17
Private Sub Splitbar_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        mSplitterMoveFlag = True
'       SB1.Visible = True
    End If
End Sub
'----------------------
'移动分割符时的操作
Private Sub Splitbar_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 And mSplitterMoveFlag = True Then
        If x <> mXPlace Then
            tSplitterMove.Enabled = True
            If leftbar.Width + x < 1800 Or leftbar.Width + x >= Me.Width * 2 / 3 Then
                Splitbar.Move 1800
                leftbar.Width = 1800
            Else
                Splitbar.Move leftbar.Width + x
                leftbar.Width = Splitbar.Left
            End If
        End If
    End If
End Sub
'----------------------
'分割符松开时的操作
Private Sub Splitbar_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 And mSplitterMoveFlag = True Then
        With VerticalMenu
            If tSplitterMove.Enabled = True Then
                tSplitterMove.Enabled = False
            End If
            If Me.Width < 1000 Then Me.Width = 1000
            If Splitbar.Left < 500 Then
                Splitbar.Left = 500     '1860
            End If
            If Splitbar.Left + Splitbar.Width + 500 > Me.Width Then
                Splitbar.Left = Me.Width - Splitbar.Width - 500
            End If
            .Width = Splitbar.Left - .Left
            leftbar.Width = .Width + 50
            .Visible = False
            .Visible = True
            .SetFocus
        End With
        mSplitterMoveFlag = False
    End If
'    SB1.Left = Splitbar.Left
'    SB1.ToolTipText = Splitbar.Top
'    SB1.Visible = False
'    Picture1.Width = Me.Width - leftbar.Width
End Sub
'==============================================================
'移动导航条时启动定时器时的操作       2002-10-17      Z  :编写人
Private Sub tSplitterMove_Timer()
    With Splitbar
        If .Left + mXPlace > 800 And .Left + mXPlace < Me.Width - 2000 Then
            .Move (.Left + mXPlace)
            leftbar.Width = .Width + .Left
        End If
    End With
    tSplitterMove.Enabled = False
End Sub

Private Sub VerticalMenu_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Me.MousePointer = 0
End Sub


Private Sub VerticalMenu_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Me.MousePointer = 0
End Sub

Private Sub VerticalMenu_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Me.MousePointer = 0
End Sub

Private Sub windows_Click(Index As Integer)
 Select Case Index
    Case 0
        Me.Arrange vbTileHorizontal
    Case 1
        Me.Arrange vbTileVertical
    Case 2
        Me.Arrange vbCascade
    Case 3
        Me.Arrange vbArrangeIcons
    Case 5  '卸载所有 MDI 子窗体
        While frmnum > 0
           Unload ActiveForm
        Wend
    Case 7
        If windows(Index).Checked Then
            CoolBar1.Visible = True
            windows(Index).Checked = False
        Else
            CoolBar1.Visible = False
            windows(Index).Checked = True
        End If
    Case 8
        If windows(Index).Checked Then
            leftbar.Visible = True
            windows(Index).Checked = False
            Toolbar.Buttons("ShowTree").Value = tbrPressed
        Else
            leftbar.Visible = False
            windows(Index).Checked = True
            Toolbar.Buttons("ShowTree").Value = tbrUnpressed
        End If
    End Select
End Sub