frmclient.frm

基于C-S结构的办公信息数据处理系。经检测绝对可用。类似OutLook界面。

         Label3.Width = FrmMain.Width - ctlSplitter.Left - 1100
         Label4.Width = FrmMain.Width - ctlSplitter.Left - 1300
         Label1.Width = FrmMain.Width - ctlSplitter.Left - 450
         Label2.Width = FrmMain.Width - ctlSplitter.Left - 450
         Label5.Width = FrmMain.Width - ctlSplitter.Left - 4300
         Label7.Width = FrmMain.Width - ctlSplitter.Left - 300
         Label6.Width = FrmMain.Width - ctlSplitter.Left - 5300
         LvMail.Left = ctlSplitter.Left + 60
         Shape1.Left = ctlSplitter.Left + 60
         HSplit.Left = ctlSplitter.Left + 60
         Frame1.Left = ctlSplitter.Left + 60
         RichTextBox1.Left = ctlSplitter.Left + 60
         HSplit.Left = Frame1.Left
         TVdir.Width = ctlSplitter.Left
         TVcontact.Width = ctlSplitter.Left
         DoEvents
         Label8.Left = Me.Width - 2400
         DoEvents
         RichTextBox1.Left = ctlSplitter.Left + 60
         DoEvents
         LvMail.Width = FrmMain.Width - ctlSplitter.Left - 260
         DoEvents
         Shape1.Width = FrmMain.Width - ctlSplitter.Left - 260
             
         DoEvents
         RichTextBox1.Width = FrmMain.Width - ctlSplitter.Left - 275
         DoEvents
         Frame1.Width = FrmMain.Width - ctlSplitter.Left - 260
         DoEvents
         LvMail.ColumnHeaders.Item(3).Width = FrmMain.Width - ctlSplitter.Left - 4340


         

         
         
         If Label8.Left < 6550 Then Label8.Visible = False Else Label8.Visible = True
         If Label9.Width > Label7.Width Then Label9.Visible = False Else Label9.Visible = True

End Sub

Private Sub Form_Unload(Cancel As Integer)
RemoveIcon
With FrmConnect.Usersock
    If FrmConnect.WindowState = vbMinimized Then FrmConnect.WindowState = vbNormal
    On Error Resume Next
    If Not .State = sckClosed Then .SendData "SignOff" & FrmConnect.strUserName
DoEvents
        If Not .State = sckClosed Then .Close
End With
  FrmConnect.Timer1.Enabled = False
  Exit Sub
'Set Lvstore = Nothing
Set OFMSGER = Nothing
End Sub
Public Sub AddIcon()
Dim rc As Long
If MailIcon = True Then Exit Sub
TC.cbSize = Len(TC)
                TC.hwnd = FrmMain.hwnd
                TC.uID = vbNull
                TC.uFlags = NIF_DOALL
                TC.uCallbackMessage = WM_MOUSEMOVE
                TC.hIcon = FrmMain.Icon
                TC.sTip = "New Office Mail" & vbNullChar
                rc = Shell_NotifyIcon(NIM_ADD, TC)
                MailIcon = True
                Beep
End Sub
Public Sub RemoveIcon()
Dim rc As Long
rc = Shell_NotifyIcon(NIM_DELETE, TC)
MailIcon = False
End Sub

Private Sub Label1_Click()
RichTextBox1_GotFocus
End Sub

Private Sub Label2_Click()
RichTextBox1_GotFocus
End Sub

Private Sub Label3_Click()
RichTextBox1_GotFocus
End Sub

Private Sub Label4_Click()
RichTextBox1_GotFocus
End Sub

Private Sub Label5_Click()
RichTextBox1_GotFocus
End Sub

Private Sub Label6_Click()
RichTextBox1_GotFocus
End Sub

Public Sub LvMail_Click()
Dim itm As ListItem
Dim Folder As String
Dim i As Integer
'Dim Lvstore As MsgLayout
'Set Lvstore = New MsgLayout
Dim rs As Long
Dim rc As Long
On Error Resume Next
If HiddenPreview = True And LvMail.SelectedItem.ListSubItems(2).Bold = False Then GoTo SkipPre      'skip the preview if not avialiable
RichTextBox1_LostFocus
    With LvMail
        For i = 1 To LvMail.ListItems.Count
        LvMail.ListItems.Item(i).Ghosted = False
        Next i
        
        Set itm = .ListItems.Item(.SelectedItem.Index)
            Lvstore.GetMsgStore (.SelectedItem.Text)
            Label3.Caption = itm.SubItems(1)
            Label4.Caption = itm.SubItems(2)
            Label6.Caption = itm.SubItems(3)
            .SelectedItem.Bold = False
            itm.ListSubItems.Item(1).Bold = False
            itm.ListSubItems.Item(2).Bold = False
            itm.ListSubItems.Item(3).Bold = False
            FrmMain.StatusBar1.Panels.Item(3).ToolTipText = ""
            RemoveIcon
            'FrmMain.StatusBar1.Panels.Item(3).Picture = Nothing
            LvMail.ListItems.Item(.SelectedItem.Index).SmallIcon = 2
            'LvMail.ListItems.Item(.SelectedItem.Index).Ghosted = True
            
    End With
    
    With FrmConnect
        Folder = TVdir.SelectedItem.Text 'been read
        If TVdir.SelectedItem.Text = "Inbox" Then Folder = "Discription"
            .Usersock.SendData "EditMessage" & .strUserName & "~~" & _
            LvMail.SelectedItem.Text & "~~" & Folder & _
            "~~" & RichTextBox1.Text
    End With

    
SkipPre:
        LvMail.Refresh
        Set itm = Nothing
       ' Set Lvstore = Nothing
        
End Sub

Private Sub LvMail_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

EnhListView_SortColumns LvMail, ColumnHeader.Index, False

End Sub

Private Sub LvMail_DblClick()
If LvMail.ListItems.Count = 0 Then Exit Sub
Call MsOpen
End Sub

Private Sub LvMail_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = vbKeyDelete Then mnu3Delete_Click
If KeyCode = vbKeyF5 Then mnuRefresh_Click
If KeyCode = 40 Then Call PreItmUp
If KeyCode = 38 Then Call PreItmDown

End Sub
Private Sub PreItmDown()
Dim itm As ListItem
Dim Folder As String
Dim i As Integer
'Dim Lvstore As MsgLayout
'Set Lvstore = New MsgLayout
Dim rs As Long
Dim rc As Long
On Error Resume Next
If HiddenPreview = True And LvMail.SelectedItem.ListSubItems(2).Bold = False Then GoTo SkipPre      'skip the preview if not avialiable

    With LvMail
        For i = 1 To LvMail.ListItems.Count
        LvMail.ListItems.Item(i).Ghosted = False
        Next i
        
        Set itm = .ListItems.Item(.SelectedItem.Index - 1)
            Lvstore.GetMsgStore (.ListItems.Item(.SelectedItem.Index - 1).Text)
            Label3.Caption = itm.SubItems(1)
            Label4.Caption = itm.SubItems(2)
            Label6.Caption = itm.SubItems(3)
            .SelectedItem.Bold = False
            itm.ListSubItems.Item(1).Bold = False
            itm.ListSubItems.Item(2).Bold = False
            itm.ListSubItems.Item(3).Bold = False
            FrmMain.StatusBar1.Panels.Item(3).ToolTipText = ""
            RemoveIcon
            'FrmMain.StatusBar1.Panels.Item(3).Picture = Nothing
            LvMail.ListItems.Item(.SelectedItem.Index).SmallIcon = 2
            'LvMail.ListItems.Item(.SelectedItem.Index).Ghosted = True
            
    End With
    
    With FrmConnect
        Folder = TVdir.SelectedItem.Text
        If TVdir.SelectedItem.Text = "Inbox" Then Folder = "Discription"
            .Usersock.SendData "EditMessage" & .strUserName & "~~" & _
            LvMail.SelectedItem.Text & "~~" & Folder & _
            "~~" & RichTextBox1.Text
    End With
SkipPre:
        LvMail.Refresh
        Set itm = Nothing
       ' Set Lvstore = Nothing
End Sub
Private Sub PreItmUp()
Dim itm As ListItem
Dim Folder As String
Dim i As Integer
'Dim Lvstore As MsgLayout
'Set Lvstore = New MsgLayout
Dim rs As Long
Dim rc As Long
On Error Resume Next
If HiddenPreview = True And LvMail.SelectedItem.ListSubItems(2).Bold = False Then GoTo SkipPre      'skip the preview if not avialiable

    With LvMail
        For i = 1 To LvMail.ListItems.Count
        LvMail.ListItems.Item(i).Ghosted = False
        Next i
        
        Set itm = .ListItems.Item(.SelectedItem.Index + 1)
            Lvstore.GetMsgStore (.ListItems.Item(.SelectedItem.Index + 1).Text)
            Label3.Caption = itm.SubItems(1)
            Label4.Caption = itm.SubItems(2)
            Label6.Caption = itm.SubItems(3)
            .SelectedItem.Bold = False
            itm.ListSubItems.Item(1).Bold = False
            itm.ListSubItems.Item(2).Bold = False
            itm.ListSubItems.Item(3).Bold = False
            FrmMain.StatusBar1.Panels.Item(3).ToolTipText = ""
            RemoveIcon
            'FrmMain.StatusBar1.Panels.Item(3).Picture = Nothing
            LvMail.ListItems.Item(.SelectedItem.Index).SmallIcon = 2
            'LvMail.ListItems.Item(.SelectedItem.Index).Ghosted = True
            
    End With
    
    With FrmConnect
        Folder = TVdir.SelectedItem.Text
        If TVdir.SelectedItem.Text = "Inbox" Then Folder = "Discription"
            .Usersock.SendData "EditMessage" & .strUserName & "~~" & _
            LvMail.SelectedItem.Text & "~~" & Folder & _
            "~~" & RichTextBox1.Text
    End With
SkipPre:
        LvMail.Refresh
        Set itm = Nothing
       ' Set Lvstore = Nothing
End Sub

Private Sub LvMail_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call MsOpen

End Sub

Private Sub LvMail_KeyUp(KeyCode As Integer, Shift As Integer)
LvMail.Refresh
End Sub

Private Sub LvMail_LostFocus()
LvMail.Refresh
End Sub

Private Sub LvMail_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If LvMail.ListItems.Count = 0 Then Exit Sub
If Button = vbRightButton Then
PopupMenu Menu3
End If

End Sub

Private Sub LvMail_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
On Error Resume Next
Dim itm As ListItem
Set itm = LvMail.ListItems.Item(LvMail.SelectedItem.Index)
    Data.SetData itm.SubItems(1) & " " & itm.SubItems(2) & " " & itm.SubItems(3) & "~~" & LvMail.SelectedItem.Text & " " & Split(RichTextBox1.Text, "[~N10~]")(0) 'copy to clipboard
    DragMessage = itm.SubItems(1) & "~~" & itm.SubItems(2) & "~~" & itm.SubItems(3) & "~~" & LvMail.SelectedItem.Text & "~~" & Split(RichTextBox1.Text, "[~N10~]")(0) & "~~" & FrmConnect.strUserName
Set itm = Nothing
End Sub
Private Sub Mnu0Close_Click()
Unload Me
End Sub

Private Sub mnu0Del_Click()

Call ItmDelete
End Sub

Private Sub Mnu0MvFold_Click()
Call MainMove
Call DragFolder
End Sub

Private Sub Mnu0New_Click()
Call CreateNew
End Sub

Private Sub mnu0Open_Click()
Call MsOpen
End Sub

Private Sub mnu0Opt_Click()
Call GetOptions
End Sub

Private Sub Mnu0Preview_Click()
If Mnu0Preview.Checked = True Then
    SaveRegKey HKEY_CURRENT_USER, "OfficeMessenger", "HidePreview", "True"
    Call FrmStyle
    Exit Sub
End If

If Mnu0Preview.Checked = False Then
    SaveRegKey HKEY_CURRENT_USER, "OfficeMessenger", "HidePreview", "False"
    Mnu0Preview.Checked = True
    HiddenPreview = False
    Frame1.Visible = True
    RichTextBox1.Visible = True
    HSplit.Visible = True
    LvMail.Height = FrmMain.HSplit.Top - 1410
    Shape1.Height = FrmMain.HSplit.Top - 1410
End If

End Sub

Private Sub mnu0Print_Click()
Call PrintFrm
End Sub

Private Sub mnu0Rubbish_Click()
Call EmptyRubbish
End Sub

Private Sub mnu2Cache_Click()
FrmConnect.Usersock.SendData "GetCache~~" & FrmConnect.strUserName & "~~" & _
TVdir.SelectedItem.Text

End Sub

Private Sub Mnu2Open_Click()
Selected = ""
TVdir_Click
End Sub
Private Sub Mnu2Rubbish_Click()
Call EmptyRubbish
End Sub

Private Sub EmptyRubbish()
Dim Response As String
Dim i As Integer
Response = MsgBox("Are you Sure you want to Delete all items?", vbExclamation + vbOKCancel, "Empty Rubbish Bin?")
    If Response = 1 Then
       FrmConnect.Usersock.SendData "EmptyBin" & FrmConnect.strUserName
       LvMail.ListItems.Clear
    End If

End Sub

Public Sub mnu3Delete_Click()
Call ItmDelete
End Sub
Public Sub ItmDelete()
On Error Resume Next
Dim itm As ListItem

If Not TVdir.SelectedItem.Text = "Rubbish Bin" Then
    Set itm = LvMail.ListItems.Item(LvMail.SelectedItem.Index)
        DragMessage = itm.SubItems(1) & "~~" & itm.SubItems(2) & "~~" & itm.SubItems(3) & "~~" & LvMail.SelectedItem.Text & "~~" & Split(RichTextBox1.Text, "[~N10~]")(0) & "~~" & FrmConnect.strUserName
        LvMail.ListItems.Remove (LvMail.SelectedItem.Index)
        LvMail.Refresh

        FrmConnect.Usersock.SendData "DragMessage" & _
        FrmConnect.strUserName & Chr(10) & "Rubbish Bin" & "~F~" & DragMessage
    
    Set itm = Nothing
Else

With FrmConnect

    .Usersock.SendData "DelMessage" & .strUserName & Chr(10) & FrmMain.LvMail.SelectedItem.Text

End With

With LvMail
If .SelectedItem.Text = "" Then
    MsgBox "No Message to Delete", vbOKOnly, "Delete Error"
    Exit Sub
Else
    .ListItems.Remove (.SelectedItem.Index)
    .ListItems.Item(.ListItems.Count).Selected = True
    RichTextBox1.Text = ""
    Label3.Caption = ""
    Label4.Caption = ""
    Label6.Caption = ""
End If
End With

End If

End Sub

Private Sub mnu3Move_Click()
Call MainMove
Call DragFolder
End Sub
Public Sub MainMove()
Dim itm As ListItem
Set itm = LvMail.ListItems.Item(LvMail.SelectedItem.Index)
    DragMessage = itm.SubItems(1) & "~~" & itm.SubItems(2) & "~~" & itm.SubItems(3) & "~~" & LvMail.SelectedItem.Text & "~~" & Split(RichTextBox1.Text, "[~N10~]")(0) & "~~" & FrmConnect.strUserName
Set itm = Nothing

End Sub

Public Sub MsOpen()
Dim itm As ListItem
Dim i As Integer
Dim frmView As FrmNew
Set frmView = New FrmNew
'Dim LvMessage As MsgLayout
'Set LvMessage = New MsgLayout
On Error Resume Next
With LvMail
If Not .SelectedItem.Text = "" Then
Set itm = .ListItems.Item(.SelectedItem.Index)
  Lvstore.GetMsgStore (.SelectedItem.Text)
        
        With FrmNew
            For i = 0 To UBound(Split(AllUsersList, "_")) - 1
            .Combo1.AddItem Split(AllUsersList, "_")(i)
                Next i
            .mnuEmail.Enabled = False
            .mnuSendF.Enabled = False
'            .mnuEdit.Enabled = False
            '.mnuInsert.Enabled = False
            .MsgItm = LvMail.SelectedItem.Text
            .Combo1.AddItem FrmConnect.strUserName
            .Combo1.Text = FrmConnect.strUserName
            .Combo1.BackColor = Me.BackColor
            .Combo1.Appearance = vbFlat
            .Combo1.Enabled = False
            .Toolbar1.Buttons.Item(1).Enabled = False
            .Text1(0).Text = itm.SubItems(1)
            .Text1(1).Text = itm.SubItems(2)
            .Label4.Caption = itm.SubItems(3)
            .RichTextBox1.Text = Split(Lvstore.SendMessageID, "[~N10~]")(0)
            .Caption = itm.SubItems(2)
            .Text1(0).Locked = True
            .Text1(0).BackColor = Me.BackColor
            .Text1(0).Appearance = vbFlat
            .Text1(0).BorderStyle = 0
            .Text1(1).Locked = True
            .Text1(1).BackColor = Me.BackColor
            .Text1(1).Appearance = vbFlat
            .Text1(1).BorderStyle = 0
            .Label1.FontBold = False
            .Label2.FontBold = False