frmoasellmain.frm

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

                Case "ANALYZER"
                    Me.menuAnalyzer.Visible = True
                    Set rstItem = New Recordset
                    rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='ANALYZER' ", GetCNClient, adOpenForwardOnly
                    i = 1
                    Do Until rstItem.EOF
                        Load Me.menuAnalyzerItem(i)
                        Me.menuAnalyzerItem(i).Caption = rstItem![Explain]
                        
                        Me.menuAnalyzerItem(i).Visible = True
                        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 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
    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 rstUserWork = New Recordset
    rstUserWork.Open "SELECT Explain From PubOAGroup Order by Type;", GetCNClient, adOpenStatic, adLockReadOnly
    i = 0
    With rstUserWork
        Do Until .EOF
            Me.VtlMenu.MenusMax = .RecordCount
            Me.VtlMenu.MenuCur = i + 1
            Me.VtlMenu.MenuCaption = ![Explain]
            Set rstWork = New Recordset
            rstWork.Open "Select FunctionID,Explain From PubOAPower Where GroupID='" & DLookUp("GroupID", "PubOAGroup", "Explain= '" & Me.VtlMenu.MenuCaption & "'") & "' ", GetCNClient, adOpenStatic, adLockReadOnly
                j = 0
                Me.VtlMenu.MenuItemsMax = rstWork.RecordCount
                Do Until rstWork.EOF
                    Me.VtlMenu.MenuItemCur = j + 1
                    Me.VtlMenu.MenuItemKey = rstWork![FunctionID]
                    Me.VtlMenu.MenuItemCaption = rstWork![Explain]
                    Set Me.VtlMenu.MenuItemIcon = LoadPicture(AppPath & "\icon6.ico")
                    j = j + 1
                    rstWork.MoveNext
                Loop
            i = i + 1
            .MoveNext
        Loop
    End With
    
'    '加载具体任务栏
'
'    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]
'            Set Me.VtlMenu.MenuItemIcon = LoadPicture(AppPath & "\icon6.ico")
'            i = i + 1
'            .MoveNext
'        Loop
'    End With
'
    '加载信息
    
    Me.VtlMenu.MenuCur = 1
    Me.VtlMenu.MenuItemCur = 0
'    EmailStyle = 1

'    UnRead
'    Set rstWork = New Recordset
'    rstWork.Open "Select DraftID,Topic From PubOAData Where Addressee='" & LoginName & "'   and Style=0", GetCNClient, adOpenStatic, adLockReadOnly
'    With rstWork
'        i = 0
'        Do Until .EOF
'            Me.VtlMenu.MenuItemsMax = rstWork.RecordCount
'            Me.VtlMenu.MenuItemCur = i + 1
'            Me.VtlMenu.MenuItemCaption = ![Topic]
'            Me.VtlMenu.MenuItemKey = ![DraftID]
'            Set Me.VtlMenu.MenuItemIcon = LoadPicture(AppPath & "\icon6.ico")
'            i = i + 1
'            .MoveNext
'        Loop
'
'        If .RecordCount = 0 Then
'            Warning "1"
'            Me.VtlMenu.MenuCur = 1
'        Else
'            Warning "0"
'            Me.VtlMenu.MenuCur = 3
'
'        End If
'    End With
     
    WorkFlow
    Me.Picture1.Visible = False
    Me.Picture2.Visible = True

'    UnRead
'    Me.lblSend.Visible = False
'    Me.lblTopic.Visible = False
'    Me.RTxtSummary.Visible = False
    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 Sub LoadEmail()
    On Error Resume Next
    Me.Picture1.Visible = True
    Me.Picture2.Visible = False
    Me.TDBGrid1.Visible = True
    Me.lblSend.Visible = True
    Me.lblTopic.Visible = True
    Me.RTxtSummary.Visible = True
    Me.RtxtSend.Visible = False
    Me.cmdLink.Visible = False
    Me.cmdSend.Visible = False
    Me.TDBGrid1.Width = Me.Picture1.Width
    Me.TDBGrid1.Height = Me.Picture1.Height / 3
    Me.lblSend.Top = Me.TDBGrid1.Height + 200
    Me.lblTopic.Top = Me.TDBGrid1.Height + Me.lblSend.Height + 200
    Me.RTxtSummary.Top = Me.lblTopic.Top + Me.lblTopic.Height + 200
    Me.RTxtSummary.Width = Me.Picture1.Width
    Me.RTxtSummary.Height = Me.Picture1.Height - Me.RTxtSummary.Top - 400
    
End Sub

Private Sub LoadTalk()
On Error Resume Next
    Me.Picture1.Visible = True
    Me.Picture2.Visible = False
    Me.TDBGrid1.Visible = True
    Me.lblSend.Visible = True
    Me.lblTopic.Visible = True
    Me.RTxtSummary.Visible = True
    Me.RtxtSend.Visible = True
    Me.cmdLink.Visible = True
    Me.cmdSend.Visible = True
    Me.TDBGrid1.Width = Me.Picture1.Width - 1200
    Me.TDBGrid1.Height = Me.Picture1.Height / 4
    Me.lblTopic.Top = Me.TDBGrid1.Top + Me.TDBGrid1.Height + 100
    Me.cmdLink.Left = Me.TDBGrid1.Width + 100
    Me.RTxtSummary.Top = Me.lblTopic.Top + Me.lblTopic.Height + 100
    Me.RTxtSummary.Width = Me.Picture1.Width
    Me.RTxtSummary.Height = Me.Picture1.Height / 4 + 300
    Me.lblSend.Top = Me.RTxtSummary.Top + Me.RTxtSummary.Height + 100
    Me.lblSend.Width = Me.Picture1.Width - 1200
    Me.cmdSend.Top = lblSend.Top - 30
    Me.cmdSend.Left = Me.Picture1.Width - 1000
    Me.RtxtSend.Top = Me.lblSend.Top + Me.lblSend.Height + 100
    Me.RtxtSend.Width = Me.Picture1.Width
    Me.RtxtSend.Height = Me.Picture1.Height / 4 + 300
End Sub
Private Sub WorkFlow()
    Me.Picture1.Visible = False
    Me.Picture2.Visible = True
    Me.Picture2.Top = Me.Picture1.Top
    Me.Picture2.Width = Me.Width - Me.Picture1.Left - 200
    Me.Picture2.Height = Me.Height - Me.Picture1.Top - 800

End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    GetCNClient.Execute "Delete from OAOnlineUser where LoginName= '" & LoginName & "' and  ComputerName ='" & LocalComputerName & "' "
    GetCNClient.Close
    GetCNServer.Close
    tcpClient.Close
    
    For i = 0 To intMax
        tcpServer(i).Close
    Next
    DoEvents
    
End Sub

Private Sub menuBasicItem_Click(Index As Integer)
On Error GoTo Err_menuBasicItem
    Dim f As Form
    Dim s As New clsInput
    If UCase(DLookUp("Type", "PubOAPower", "Explain='" & Me.menuBasicItem(Index).Caption & "'")) = "FORM" Then
        Set f = Forms.Add(DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuBasicItem(Index).Caption & "'"))
        f.Show 1
    Else
        Set s = New clsInput
        s.FormName = DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuBasicItem(Index).Caption & "'")
        s.ShowForm
        Set s = Nothing
    End If
    
    Exit Sub
Err_menuBasicItem:
    
    MisMsg "menuBasicItem Error : " & Err.Description
    Exit Sub

End Sub

Private Sub menuFinanceItem_Click(Index As Integer)
On Error GoTo Err_menuFinanceItem
    Dim f As Form
    Dim s As New clsInput
    If UCase(DLookUp("Type", "PubOAPower", "Explain='" & Me.menuFinanceItem(Index).Caption & "'")) = "FORM" Then
        Set f = Forms.Add(DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuFinanceItem(Index).Caption & "'"))
        f.Show 1
    Else
        Set s = New clsInput
        s.FormName = DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuFinanceItem(Index).Caption & "'")
        s.ShowForm
        Set s = Nothing
    End If

    Exit Sub

Err_menuFinanceItem:
    MisMsg "menuFinanceItem Error : " & Err.Description
    Exit Sub
End Sub

Private Sub menuPower_Click()
    frmPubOAPower.Show
End Sub

Private Sub menuPurchaseItem_Click(Index As Integer)
On Error GoTo Err_menuPurchaseItem
    Dim f As Form
    Dim s As New clsInput
    If UCase(DLookUp("Type", "PubOAPower", "Explain='" & Me.menuPurchaseItem(Index).Caption & "'")) = "FORM" Then
        Set f = Forms.Add(DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuPurchaseItem(Index).Caption & "'"))
        f.Show 1
    Else
        Set s = New clsInput
        s.FormName = DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuPurchaseItem(Index).Caption & "'")
        s.ShowForm
        Set s = Nothing
    End If

    Exit Sub
    
    
Err_menuPurchaseItem:
    MisMsg "menuPurchaseItem Error : " & Err.Description
    Exit Sub
    

End Sub

Private Sub menuSellItem_Click(Index As Integer)
On Error GoTo Err_menuSellItem
    Dim f As Form
    Dim s As New clsInput
    If UCase(DLookUp("Type", "PubOAPower", "Explain='" & Me.menuSellItem(Index).Caption & "'")) = "FORM" Then
        Set f = Forms.Add(DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuSellItem(Index).Caption & "'"))
        f.Show 1
    Else
        Set s = New clsInput
        s.FormName = DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuSellItem(Index).Caption & "'")
        s.ShowForm
        Set s = Nothing
    End If
    
    Exit Sub



Err_menuSellItem:
    MisMsg "menuSellItem Error : " & Err.Description
    Exit Sub
End Sub

Private Sub menuStockItem_Click(Index As Integer)
On Error GoTo Err_menuStockItem
    Dim f As Form
    Dim s As New clsInput
    If UCase(DLookUp("Type", "PubOAPower", "Explain='" & Me.menuStockItem(Index).Caption & "'")) = "FORM" Then
        Set f = Forms.Add(DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuStockItem(Index).Caption & "'"))
        f.Show 1
    Else
        Set s = New clsInput
        s.FormName = DLookUp("FunctionID", "PubOAPower", "Explain='" & Me.menuStockItem(Index).Caption & "'")
        s.ShowForm
        Set s = Nothing
    End If

    Exit Sub


Err_menuStockItem:
    MisMsg "menuStockItem Error : " & Err.Description
    Exit Sub
End Sub

Private Sub meunExit_Click()
    Unload Me
End Sub

Private Sub meunPower_Click()
    frmPubOAPower.Show
End Sub

Private Sub Picture1_Resize()
'    LoadEmail
    Me.TDBGrid1.Width = Me.Picture1.Width
    Me.TDBGrid1.Height = Me.Picture1.Height / 3
    Me.lblSend.Top = Me.TDBGrid1.Height + 200
    Me.lblTopic.Top = Me.TDBGrid1.Height + Me.lblSend.Height + 200
    Me.RTxtSummary.Top = Me.lblTopic.Top + Me.lblTopic.Height + 200
    Me.RTxtSummary.Width = Me.Picture1.Width
    Me.RTxtSummary.Height = Me.Picture1.Height - Me.RTxtSummary.Top - 400

End Sub



Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)

End Sub

'Private Sub RtxtSend_KeyPress(KeyAscii As Integer)
'    If KeyAscii = 13 Then
'        If Asc(Right(Me.RtxtSend.Text, 1)) = 10 Then
'            cmdSend_Click
'        End If
'    End If
'End Sub

Private Sub tcpServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)

   If Index = 0 Then
      intMax = intMax + 1
      Load tcpServer(intMax)
      tcpServer(intMax).LocalPort = 0
      tcpServer(intMax).Accept requestID
      'Load txtData(intMax)
   End If

End Sub


Private Sub tcpServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim strData As String
    If Me.TDBGrid1.Columns.Count > 2 Then Exit Sub
    
    tcpServer(Index).GetData strData
    
    If strData <> "" Then
        Beep
        'MisMsg "你有新信息。"
        Warning "1"

    End If