oamain.frm

一个OA办公自动化管理系统

    
    If LinkServer(ServerName) = 0 Then Exit Sub
    
    If Me.RtxtSend.Text = "" Then Exit Sub
    tcpClient.SendData LoginName & ": " & Trim(RtxtSend.Text)
    Me.RtxtSend.Text = ""
End Sub
Private Sub FormLoadMenu()
End Sub



Private Function iniMenu() As Integer
'On Error GoTo Err_iniMenu
    
    
    Dim rstMenu As Recordset, i As Integer, rstItem As Recordset, j As Integer
    iniMenu = 0
    
    Me.menuBasic.Visible = False
    Me.menuPurchase.Visible = False
    Me.menuSell.Visible = False
    Me.menuPurchase.Visible = False
    Me.menuStock.Visible = False
    Me.menuFinance.Visible = False
    Me.menuAnalyzer.Visible = False
    Set rstMenu = New Recordset
    rstMenu.Open "Select * From v_UserWork_Group where UserID='" & LoginName & "' ", GetCNClient, adOpenForwardOnly
        Do Until rstMenu.EOF
                     
            Select Case UCase(rstMenu![sysGroupID])
                Case "BASIC"
                    
                    Me.menuBasic.Visible = True
                    Set rstItem = New Recordset
                    rstItem.Open "Select * From v_UserWork_Item  where UserID = '" & LoginName & "' and sysGroupID='BASIC' Order by SubGroupID,IndexNo ", GetCNClient, adOpenForwardOnly
                    i = 1
                    j = 0
                    Do Until rstItem.EOF
                        If j <> rstItem![SubGroupID] Then
                            Load Me.menuBasicItem(i)
                            Me.menuBasicItem(i).Caption = "-"
                            i = i + 1
                        End If
                        Load Me.menuBasicItem(i)
                        Me.menuBasicItem(i).Caption = rstItem![Explain]
                        
                        Me.menuBasicItem(i).Visible = True
                        j = rstItem![SubGroupID]
                        rstItem.MoveNext
                        i = i + 1
                    Loop
                    Me.menuBasicItem(0).Visible = False

                    Set rstItem = Nothing
                Case "PURCHASE"
                    Me.menuPurchase.Visible = True
                    Set rstItem = New Recordset
                    rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='PURCHASE'  Order by SubGroupID,IndexNo", GetCNClient, adOpenForwardOnly
                    i = 1
                    j = 0
                    Do Until rstItem.EOF
                        If j <> rstItem![SubGroupID] Then
                            Load Me.menuPurchaseItem(i)
                            Me.menuPurchaseItem(i).Caption = "-"
                            i = i + 1
                        End If

                        Load Me.menuPurchaseItem(i)
                        Me.menuPurchaseItem(i).Caption = rstItem![Explain]
                        
                        Me.menuPurchaseItem(i).Visible = True
                        j = rstItem![SubGroupID]
                        rstItem.MoveNext
                        i = i + 1
                    Loop
                    Me.menuPurchaseItem(0).Visible = False

                    Set rstItem = Nothing
                Case "SELL"
                    Me.menuSell.Visible = True
                    Set rstItem = New Recordset
                    rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='SELL'  Order by SubGroupID,IndexNo", GetCNClient, adOpenForwardOnly
                    i = 1
                    j = 0
                    Do Until rstItem.EOF
                        If j <> rstItem![SubGroupID] Then
                            Load Me.menuSellItem(i)
                            Me.menuSellItem(i).Caption = "-"
                            i = i + 1
                        End If
                        Load Me.menuSellItem(i)
                        Me.menuSellItem(i).Caption = rstItem![Explain]
                        
                        Me.menuSellItem(i).Visible = True
                        j = rstItem![SubGroupID]
                        rstItem.MoveNext
                        i = i + 1
                    Loop
                    Me.menuSellItem(0).Visible = False

                    Set rstItem = Nothing
                Case "STOCK"
                    Me.menuStock.Visible = True
                    Set rstItem = New Recordset
                    rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='STOCK'  Order by SubGroupID,IndexNo", GetCNClient, adOpenForwardOnly
                    i = 1
                    j = 0
                    Do Until rstItem.EOF
                        If j <> rstItem![SubGroupID] Then
                            Load Me.menuStockItem(i)
                            Me.menuStockItem(i).Caption = "-"
                            i = i + 1
                        End If
                        Load Me.menuStockItem(i)
                        Me.menuStockItem(i).Caption = rstItem![Explain]
                        
                        Me.menuStockItem(i).Visible = True
                        j = rstItem![SubGroupID]
                        rstItem.MoveNext
                        i = i + 1
                    Loop
                    Me.menuStockItem(0).Visible = False

                    Set rstItem = Nothing
                Case "FINANCE"
                    Me.menuFinance.Visible = True
                    Set rstItem = New Recordset
                    rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='FINANCE'  Order by SubGroupID,IndexNo", GetCNClient, adOpenForwardOnly
                    i = 1
                    j = 0
                    Do Until rstItem.EOF
                        If j <> rstItem![SubGroupID] Then
                            Load Me.menuFinanceItem(i)
                            Me.menuFinanceItem(i).Caption = "-"
                            i = i + 1
                        End If
                        Load Me.menuFinanceItem(i)
                        Me.menuFinanceItem(i).Caption = rstItem![Explain]
                        
                        Me.menuFinanceItem(i).Visible = True
                        j = rstItem![SubGroupID]
                        rstItem.MoveNext
                        i = i + 1
                    Loop
                    Me.menuFinanceItem(0).Visible = False

                Case "ANALYZER"
                    Me.menuAnalyzer.Visible = True
                    Set rstItem = New Recordset
                    rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='ANALYZER'  Order by SubGroupID,IndexNo", GetCNClient, adOpenForwardOnly
                    i = 1
                    j = 0
                    Do Until rstItem.EOF
                        If j <> rstItem![SubGroupID] Then
                            Load Me.menuAnalyzerItem(i)
                            Me.menuAnalyzerItem(i).Caption = "-"
                            i = i + 1
                        End If
                        Load Me.menuAnalyzerItem(i)
                        Me.menuAnalyzerItem(i).Caption = rstItem![Explain]
                        
                        Me.menuAnalyzerItem(i).Visible = True
                        j = rstItem![SubGroupID]
                        rstItem.MoveNext
                        i = i + 1
                    Loop
                    Me.menuAnalyzerItem(0).Visible = False
                    Set rstItem = Nothing
                
                End Select
                    
'            i = i + 1
            rstMenu.MoveNext
        Loop
        Set rstMeun = Nothing
        iniMenu = 1

    Exit Function
Err_iniMenu:
    iniMenu = 0
    MisMsg "iniMeun Error : " & Err.Description
    Exit Function
End Function

Private Function IniOutLook(isOA As String) As Integer
On Error GoTo Err_iniOutLook
    IniOutLook = 0
        
    Dim rstUserWork As Recordset, rstWork As Recordset
    
    If isOA = 1 Then  '使用OA工作流
    
        
        '加载任务栏
        Me.Picture1.Visible = False
        Me.Picture2.Visible = False
        Set rstUserWork = New Recordset
        rstUserWork.Open "SELECT WorkType From PubOAiniUserMain GROUP BY WorkType,WTOrderBy Order by WTOrderby;", GetCNClient, adOpenStatic, adLockReadOnly
        i = 0
        With rstUserWork
           Me.VtlMenu.MenusMax = .RecordCount
           Do Until .EOF
                Me.VtlMenu.MenuCur = i + 1
                Me.VtlMenu.MenuCaption = ![WorkType]
                Set rstWork = New Recordset
                rstWork.Open "Select UserJob,icoName From PubOAiniUserMain Where WorkType='" & Me.VtlMenu.MenuCaption & "' ", GetCNClient, adOpenStatic, adLockReadOnly
                    j = 0
                    Me.VtlMenu.MenuItemsMax = rstWork.RecordCount
                    Do Until rstWork.EOF
                        Me.VtlMenu.MenuItemCur = j + 1
                        Me.VtlMenu.MenuItemCaption = rstWork![UserJob]
                        If Dir(App.Path & "\" & rstWork![icoName] & ".ico") <> "" Then
                        
                            Set Me.VtlMenu.MenuItemIcon = LoadPicture(App.Path & "\" & rstWork![icoName] & ".ico")
                        
                        End If
                        j = j + 1
                        rstWork.MoveNext
                    Loop
                i = i + 1
                .MoveNext
            Loop
        End With
        
        '加载具体任务栏
        
        IniOutLookGroup 1


'        Me.VtlMenu.MenuCur = 2
'        Set rstWork = New Recordset
'        rstWork.Open "Select FunctionID,Explain,ID From PubOAUserWork Where UserID='" & LoginName & "' ", GetCNClient, adOpenStatic, adLockReadOnly
'        With rstWork
'            i = 0
'            Do Until .EOF
'                Me.VtlMenu.MenuItemsMax = rstWork.RecordCount + 1
'                Me.VtlMenu.MenuItemCur = i + 2
'                Me.VtlMenu.MenuItemCaption = ![Explain]
'                Me.VtlMenu.MenuItemKey = ![FunctionID]
'                If Dir(App.Path & "\" & rstWork![FunctionID] & ".ico") <> "" Then
'                    Set Me.VtlMenu.MenuItemIcon = LoadPicture(App.Path & "\" & rstWork![FunctionID] & ".ico")
'                Else
'                    Set Me.VtlMenu.MenuItemIcon = LoadPicture(App.Path & "\icon6.ico")
'                End If
'                i = i + 1
'                .MoveNext
'            Loop
'        End With
        
        '加载信息
        
        Me.VtlMenu.MenuCur = 1
        Me.VtlMenu.MenuItemCur = 0
        Dim ii As Integer
        ii = DrawFlow()

        UnRead

    
    Else
        
        '不使用OA
        
        TBEnabled
        IniOutLookGroup 0

        
    End If
    
    IniOutLook = 1
    Exit Function
    
Err_iniOutLook:
    IniOutLook = 0
    MisMsg "iniOutLook Error : " & Err.Description
    Exit Function
End Function

Private Sub IniOutLookGroup(i As Integer)
        
        Dim rstUserWork  As Recordset, j As Integer, k As Integer
        k = i
        Set rstUserWork = New Recordset
        
        rstUserWork.Open "SELECT Explain From MenuGroup Order by IndexNo;", GetCNClient, adOpenStatic, adLockReadOnly
        With rstUserWork
            
            Me.VtlMenu.MenusMax = .RecordCount
           Do Until .EOF
                 
                Me.VtlMenu.MenuCur = i + 1
                Me.VtlMenu.MenuCaption = ![Explain]
                Set rstWork = New Recordset
                rstWork.Open "Select FunctionID,Explain From PubOAPower  Where GroupID='" & DLookUp("GroupID", "MenuGroup", "Explain= '" & Me.VtlMenu.MenuCaption & "'") & "' Order by subGroupID,IndexNo ", GetCNClient, adOpenStatic, adLockReadOnly
                    j = 0
                    If k = 1 And i = 1 Then
                        Me.VtlMenu.MenuItemsMax = rstWork.RecordCount + 1
                    Else
                        Me.VtlMenu.MenuItemsMax = rstWork.RecordCount
                    End If
                    Do Until rstWork.EOF
                        If k = 1 And Me.VtlMenu.MenuCur = 2 And j = 0 Then
                            Me.VtlMenu.MenuItemCur = 0
                            Me.VtlMenu.MenuItemKey = "Flow"
                            Me.VtlMenu.MenuItemCaption = "总流程图"
                            j = j + 1
                        End If

                        Me.VtlMenu.MenuItemCur = j + 1
                        Me.VtlMenu.MenuItemKey = rstWork![FunctionID]
                        Me.VtlMenu.MenuItemCaption = rstWork![Explain]
                        If Dir(App.Path & "\" & rstWork![FunctionID] & ".ico") <> "" Then
                            Set Me.VtlMenu.MenuItemIcon = LoadPicture(App.Path & "\" & rstWork![FunctionID] & ".ico")
                        Else
                            Set Me.VtlMenu.MenuItemIcon = LoadPicture(App.Path & "\icon6.ico")
                        End If
                        j = j + 1
                        rstWork.MoveNext
                    Loop
                i = i + 1
                .MoveNext
            Loop
        End With
        
        
End Sub


Private Sub Command1_Click()
WorkFlow
If DrawFlow Then
End If
End Sub

Private Sub Form_Load()
'On Error GoTo Err_VtlForm_Load
    Dim i As Integer, j As Integer, rstUserWork As Recordset, rstWork As Recordset
    Dim AppPath As String, rstMeun As Recordset, rstIsOA As Recordset
    AppPath = App.Path
    If iniMenu = 0 Then MisMsg "iniMenu error"
    'Me.Show
    'DoEvents
    Me.Caption = LoginName & "  工作台"
    intMax = 0
    EmailStyle = 0
    tcpServer(0).LocalPort = 1001
    tcpServer(0).Listen
    'tcpClient.RemotePort = 1001
    'tcpClient.RemoteHost = "luo"
    Set rstIsOA = New Recordset
    rstIsOA.Open "Select IsOA From AccountName Where AccountId='" & strAccountName & "'", GetCNLocal, adOpenForwardOnly
    If rstIsOA.EOF Then Exit Sub
    If IniOutLook(rstIsOA![isOA]) = 0 Then MisMsg "iniOutLook Error"
    
    
    Me.VtlMenu.MenuCur = 1
    Set rstIsOA = Nothing
 
    EmailStyle = 1
    WorkFlow
    Me.Picture1.Visible = False
    Me.Picture2.Visible = True


    UnRead
    Exit Sub
Err_VtlForm_Load:
    MisMsg "VtlForm_Load Error : " & Err.Description
    Exit Sub
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Me.VtlMenu.Height = Me.Height - Me.VtlMenu.Top - 800
    Me.Picture1.Width = Me.Width - Me.Picture1.Left - 200
    Me.Picture1.Height = Me.Height - Me.Picture1.Top - 400
    Me.lblState.Width = Me.Picture1.Width
    Me.Gif89a1.Left = Me.Width - 700
    
End Sub

Private Function DrawFlow() As Integer
    DrawFlow = 0
    Dim rstflow As Recordset, strNode As String, strNextNode As String
    Dim i As Integer, j As Integer, IsLoad As Integer, k As Integer, NextIsLoad As Integer
    'Stop
    For i = 1 To lblNode.Count - 1
        Unload Me.lblNode(i)
    Next
    
    For i = 1 To Line1.Count - 1
        Unload Me.Line1(i)
    Next
    
    For i = 1 To Line2.Count - 1
        Unload Me.Line2(i)
    Next
    
    For i = 1 To Line3.Count - 1
        Unload Me.Line3(i)