oamain

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

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()
Dim i As Integer
    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
    VtlMenu.MenusMax = 0
    
End Sub

Private Sub Label1_Click()

End Sub

Private Sub menuExit_Click()
Unload Me
frmLogin.Show
End Sub

Private Sub menuMediPS_Click()
    frmUser.Show 1
End Sub

'Private Sub PicNode_Click(Index As Integer)
'    MisMsg Me.lblNode(Index).Caption & "TAg:" & Me.lblNode(Index).Tag
'End Sub

Private Sub PicNode_DblClick(Index As Integer)
On Error GoTo Err_PicNode
    Dim strFuncID As String
    strFuncID = UCase(strMid(Me.PicNode(Index).Tag, 1))
    AddForm strFuncID

    Exit Sub

Err_PicNode:
    MisMsg "PicNode Error : " & Err.Description
    Exit Sub

End Sub

Private Sub picNode_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then
        IsDown = 1
    Else
        IsDown = 0
    End If
    
    Me.lblMove.Visible = True
    Me.lblMove.Caption = ""
    Me.lblMove.Left = Me.PicNode(Index).Left
    Me.lblMove.Top = Me.PicNode(Index).Top
    Me.lblMove.Width = Me.PicNode(Index).Width
    Me.lblMove.Height = Me.PicNode(Index).Height
    cx = x
    cy = y
End Sub


Private Sub picNode_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If IsDown = 1 Then
        Me.lblMove.Left = x + Me.PicNode(Index).Left - cx
        If Me.lblMove.Left < 50 Then     'Me.Picture2.Left
            lblMove.Left = 50
        End If
        
        If Me.lblMove.Left > 8700 Then    'Me.Picture2.Left
            lblMove.Left = 8700
        End If
        
        Me.lblMove.Top = y + Me.PicNode(Index).Top - cy
        If lblMove.Top < 50 Then
            lblMove.Top = 50
        End If
        
        If lblMove.Top > 6200 Then
            lblMove.Top = 6200
        End If
    
    End If
End Sub

Private Sub picNode_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If LoginName = "Admin" Then
    IsDown = 0
    Me.PicNode(Index).Left = Me.lblMove.Left
    Me.PicNode(Index).Top = Me.lblMove.Top
    Dim rstNode As Recordset
    'MsgBox "00" & strMid(PicNode(Index).Tag, 4) & "00"
    Set rstNode = New Recordset
    rstNode.Open "Select NodeLeft,NodeTop From v_DrawFlow Where FuncID = '" & strMid(PicNode(Index).Tag, 1) & "' and  GroupID = '" & strMid(PicNode(Index).Tag, 2) & "' and TeamID = '" & strMid(PicNode(Index).Tag, 3) & "' and  FuncPower ='" & strMid(PicNode(Index).Tag, 4) & "'", GetCNClient, adOpenStatic, adLockOptimistic
    
    Do Until rstNode.EOF
        rstNode![NodeLeft] = Me.lblMove.Left
        rstNode![NodeTop] = Me.lblMove.Top
        rstNode.Update
        rstNode.MoveNext
    Loop

    Set rstNode = New Recordset
    
    rstNode.Open "Select NextNodeLeft,NextNodeTop From v_DrawFlow Where NextFuncID = '" & strMid(PicNode(Index).Tag, 1) & "'  and  NextGroupID = '" & strMid(PicNode(Index).Tag, 2) & "' and NextTeamID = '" & strMid(PicNode(Index).Tag, 3) & "' and  NextFuncPower ='" & strMid(PicNode(Index).Tag, 4) & "'", GetCNClient, adOpenStatic, adLockOptimistic
    Do Until rstNode.EOF
        rstNode![NextNodeLeft] = Me.lblMove.Left
        rstNode![NextNodeTop] = Me.lblMove.Top
        rstNode.Update
        rstNode.MoveNext
    Loop
    Set rstNode = Nothing
    IsDown = DrawFlow(Me.VtlMenu.MenuItemKey)
End If
    Me.lblMove.Visible = False

End Sub

Private Sub MenuAbout_Click()
    pub_Splash.Show
End Sub

Private Sub menuAnalyzerItem_Click(Index As Integer)
On Error GoTo Err_menuAnalyzerItem
    Dim strFuncID As String
    strFuncID = Me.menuAnalyzerItem(Index).Tag
    Me.MousePointer = 11
    AddForm strFuncID
    Me.MousePointer = 0

    Exit Sub

Err_menuAnalyzerItem:
    MisMsg "menuAnalyzerItem Error : " & Err.Description
    Me.MousePointer = 0
    Exit Sub

End Sub

Private Sub menuBasicItem_Click(Index As Integer)
On Error GoTo Err_menuBasicItem
    Dim strFuncID As String
    Me.MousePointer = 11
    strFuncID = Me.menuBasicItem(Index).Tag
    AddForm strFuncID
    Me.MousePointer = 0
    
    Exit Sub
Err_menuBasicItem:
    
    MisMsg "menuBasicItem Error : " & Err.Description
    Me.MousePointer = 0
    Exit Sub

End Sub

Private Sub menuFinanceItem_Click(Index As Integer)
'On Error GoTo Err_menuFinanceItem
    Dim strFuncID As String
    strFuncID = menuFinanceItem(Index).Tag
    Me.MousePointer = 11
    AddForm strFuncID
    Me.MousePointer = 0
    Exit Sub

Err_menuFinanceItem:
    MisMsg "menuFinanceItem Error : " & Err.Description
    Me.MousePointer = 0
Exit Sub
End Sub

Private Sub menuIndex_Click()
    Dim nRet As Integer, HelpFile As String
'    MsgBox App.Path & "\erphelp.chm"
'    nRet = Shell(App.Path & "\hh.exe  ")
'    MsgBox nRet
'    如果这个工程没有帮助文件，显示消息给用户
'    可以在“工程属性”对话框中为应用程序设置帮助文件

    SendKeys "{F1}"
'    If Len(App.HelpFile) = 0 Then
'        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
'    Else

    'On Error Resume Next
'        nRet = OSWinHelp(Me.hwnd, HelpFile, 261, 0)
'        If Err Then
'            MsgBox Err.Description
'        End If
'    End If

End Sub

Private Sub menuPower_Click()
    frmPubOAPower.Show
End Sub

Private Sub menuPurchaseItem_Click(Index As Integer)
'On Error GoTo Err_menuPurchaseItem
    Dim strFuncID As String
    Me.MousePointer = 11
    strFuncID = Me.menuPurchaseItem(Index).Tag
    AddForm strFuncID
    Me.MousePointer = 0

    Exit Sub
    
    
Err_menuPurchaseItem:
    MisMsg "menuPurchaseItem Error : " & Err.Description
    Me.MousePointer = 0
    Exit Sub
    

End Sub

Private Sub menuSellItem_Click(Index As Integer)
On Error GoTo Err_menuSellItem
    Dim strFuncID As String
    Me.MousePointer = 11
    strFuncID = Me.menuSellItem(Index).Tag
    AddForm strFuncID
    Me.MousePointer = 0

    Exit Sub



Err_menuSellItem:
    MisMsg "menuSellItem Error : " & Err.Description
    Me.MousePointer = 0
    Exit Sub
End Sub

Private Sub menuStockItem_Click(Index As Integer)
On Error GoTo Err_menuStockItem
    Dim strFuncID As String
    'MsgBox Me.menuStockItem(Index).Tag
    Me.MousePointer = 11
    strFuncID = Me.menuStockItem(Index).Tag
    AddForm strFuncID
    Me.MousePointer = 0

    Exit Sub


Err_menuStockItem:
    MisMsg "menuStockItem Error : " & Err.Description
    Me.MousePointer = 0
    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 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
    
    Me.RTxtSummary.Text = Me.RTxtSummary.Text & strData & Chr(13) & Chr(10)

End Sub

Private Sub TDBGrid1_DblClick()
    If Me.TDBGrid1.Columns.Count > 2 Then
        'MsgBox strMid(Me.TDBGrid1.Columns(7).Text, 2)
        AddForm strMid(Me.TDBGrid1.Columns(5).Text, 1), strMid(Me.TDBGrid1.Columns(5).Text, 2)
        'frmPubOAEMail.Show 1
    End If

End Sub
Private Sub FormatTDGrid()
    
    Me.TDBGrid1.MarqueeStyle = 4
    Me.TDBGrid1.Columns(0).Caption = "发件人"
    Me.TDBGrid1.Columns(1).Caption = "主题"
    Me.TDBGrid1.Columns(2).Caption = "发送日期"
    Me.TDBGrid