系统_主操作桌面.frm

适合于中小型企业管理

    End If

End Sub

Private Sub tvTreeView_KeyPress(KeyAscii As Integer)                          '用户按回车键执行相应功能
    
    If KeyAscii = vbKeyReturn Then
        isLeftButton = True
        tvTreeViewdblclickok = True
        Call tvTreeView_DblClick
    End If

End Sub

Private Sub tvTreeView_DblClick()                                             '选择功能
    If tvTreeViewdblclickok = False Then Exit Sub
    If Not isLeftButton Then Exit Sub
    
    If tvTreeView.SelectedItem.Children = 0 Then
        Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm='" + Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) + "'")
        If Not Xtgnbrec.EOF Then
            gnsyte = Trim(Xtgnbrec.Fields("gnsy"))
            Call Zxxymk(gnsyte)
        End If
    End If

End Sub

Public Sub Zxxymk(gnsy As String)                                            '根据用户选择执行相应程序
  
    Dim Rectemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '临时查询字符串
  
    If Len(Trim(gnsy)) = 0 Then
        Exit Sub
    End If
    
    On Error GoTo Cwcl:
    Select Case gnsy
        '文件
        Case "Gy_register"                       '用户重新注册
            SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "login_mode", "30"
            Timer1.Interval = 10
            Timer1.Enabled = True
            Shell App.Path & "\YdErp2008.exe", vbNormalFocus
        Case "Gy_quit"
            Unload XT_Main
        
    '辅料管理
        Case "Rc_Flgl_JBXX_CKGL"                          '仓库
            If Not Security_Log("Rc_Flgl_JBXX_CKGL", Xtczybm, 1, True) Then
                Exit Sub
            End If
            WhFrmCkxx.Show
            
        Case "Rc_Flgl_JBXX_WZLB"                          '物资类别
            If Not Security_Log("Rc_Flgl_JBXX_WZLB", Xtczybm, 1, True) Then
                Exit Sub
            End If
            WhFrmLbxx.Show
        
        Case "Rc_Flgl_JBXX_WZXX"                          '物资信息
            If Not Security_Log("Rc_Flgl_JBXX_WZXX", Xtczybm, 1, True) Then
                Exit Sub
            End If
            WhFrmCpxx.Show
            
        Case "Rc_Flgl_JBXX_GYSGL"                          '供应商信息
            If Not Security_Log("Rc_Flgl_JBXX_GYSGL", Xtczybm, 1, True) Then
                Exit Sub
            End If
            WhFrmLwdw.Show
            
        Case "Rc_Flgl_JBXX_Qc"                          '期初初始化
            If Not Security_Log("Rc_Flgl_JBXX_Qc", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm期初初始化.Show
    
        '功能区
    
            Case "Rc_Flgl_LCGL_JHSQ"                          '计划申请
            If Not Security_Log("Rc_Flgl_LCGL_JHSQ", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm计划申请.Show
            
            Case "Rc_Flgl_LCGL_JHSH"                          '计划审核
            If Not Security_Log("Rc_Flgl_LCGL_JHSH", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm计划审核.Show
            
            Case "Rc_Flgl_LCGL_SSCG"                          '实施采购
            If Not Security_Log("Rc_Flgl_LCGL_SSCG", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm实施采购.Show
            
            Case "Rc_Flgl_LCGL_CGSH"                          '采购审核
            If Not Security_Log("Rc_Flgl_LCGL_CGSH", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm采购审核.Show
            
            Case "Rc_Flgl_WZGL_CKDJ"                          '出库登记
            If Not Security_Log("Rc_Flgl_WZGL_CKDJ", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm出库登记.Show

            Case "Rc_Flgl_WZGL_CKSH"                          '出库审核
            If Not Security_Log("Rc_Flgl_WZGL_CKSH", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm出库审核.Show
            
            Case "Rc_Flgl_WZGL_MXCX"                          '明细查询
            If Not Security_Log("Rc_Flgl_WZGL_MXCX", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm明细查询.Show
            
            Case "Rc_Flgl_WZGL_KCTJ"                          '库存统计
            If Not Security_Log("Rc_Flgl_WZGL_KCTJ", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm库存统计.Show
            
            Case "Rc_Flgl_PJGL_PJSH"                          '票据审核
            If Not Security_Log("Rc_Flgl_PJGL_PJSH", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm票据审核.Show
            
            Case "Rc_Flgl_PJGL_PJCX"                          '票据查询
            If Not Security_Log("Rc_Flgl_PJGL_PJCX", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm票据查询.Show
            
            Case "Rc_Flgl_PJGL_PJYS"                          '票据样式
            If Not Security_Log("Rc_Flgl_PJGL_PJYS", Xtczybm, 1, True) Then
                Exit Sub
            End If
            Frm票据样式.Show
    '*********************************************
        Case "Gy_gnbmjsq"                        '计算器
            Shell App.Path & "\calc.exe", vbNormalFocus
        Case "Gy_gnbmjsb"                        '记事本
            Shell App.Path & "\Notepad.exe", vbNormalFocus
        
        '帮助
        Case "Gy_xtbz"                           '系统帮助
            Call F1bz
        Case "Gy_gy"                             '关于
            XT_frmAbout.Show 1
    End Select
    
    '用户退出时写上机日志
   Security_Log gnsy, Xtczybm, 2, False
   
    Exit Sub
Cwcl:
    Tsxx = "此项系统功能有待完善!"
    Call Xtxxts(Tsxx, 0, 4)
    Exit Sub

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)        '用户关闭窗体
    If Unload_TF = False Then
        Cancel = 1
        Me.WindowState = 1
    End If
End Sub

Private Sub Form_Load()
    '设置窗体图标
    Me.Icon = XT_Main.Icon
    '设置窗体位置大小,并调入系统功能树
    Me.Left = 0
    Me.Top = 0
    Me.Width = XT_Main.Width - 60
    Me.Height = XT_Main.Height - 760 - 690
    Call Cshgns
    '启动调入数据等待提示
    Load Xt_Wait
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Dim i 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.Title, "Settings", "ViewMode", lvListView.View
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls imgSplitter.Left
End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True
End Sub

Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single
    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub

Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False
    lvListView.Refresh
End Sub

Sub SizeControls(X As Single)
    On Error Resume Next
    '设置 Width 属性
    If X < 3500 Then X = 3500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    tvTreeView.Width = X
    imgSplitter.Left = X
    lvListView.Left = X + 40
    lvListView.Width = Me.Width - (tvTreeView.Width + 140)
    lblTitle(0).Width = tvTreeView.Width
    lblTitle(1).Left = lvListView.Left + 20
    lblTitle(1).Width = lvListView.Width - 40
    '设置 Top 属性
    tvTreeView.Top = tbToolBar.Height + picTitles.Height
    lvListView.Top = tvTreeView.Top
    '设置 height 属性
    tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
    lvListView.Height = tvTreeView.Height
    imgSplitter.Top = tvTreeView.Top
    imgSplitter.Height = tvTreeView.Height
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "返回"
            tvTreeView.SetFocus
              SendKeys "{up}", True
        Case "向前"
             tvTreeView.SetFocus
              SendKeys "{DOWN}", True
        Case "大图标"
            lvListView.View = lvwIcon
        Case "小图标"
            lvListView.View = lvwSmallIcon
        Case "列表"
            lvListView.View = lvwList
        Case "详细资料"
            lvListView.View = lvwReport
    End Select
End Sub