frmclient.frm

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

         EndProperty
         Height          =   255
         Left            =   960
         TabIndex        =   7
         Top             =   360
         Width           =   5175
      End
      Begin VB.Label Label3 
         Caption         =   "Label3"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   720
         TabIndex        =   6
         Top             =   120
         Width           =   3135
      End
      Begin VB.Label Label2 
         Caption         =   "Subject:"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   360
         Width           =   735
      End
      Begin VB.Label Label1 
         Caption         =   "From:"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   120
         Width           =   615
      End
   End
   Begin RichTextLib.RichTextBox RichTextBox1 
      Height          =   2775
      Left            =   3000
      TabIndex        =   13
      Top             =   4200
      Width           =   6240
      _ExtentX        =   11007
      _ExtentY        =   4895
      _Version        =   393217
      BorderStyle     =   0
      Enabled         =   -1  'True
      ReadOnly        =   -1  'True
      ScrollBars      =   2
      DisableNoScroll =   -1  'True
      Appearance      =   0
      AutoVerbMenu    =   -1  'True
      TextRTF         =   $"FrmClient.frx":CFD2
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Courier New"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label9 
      BackColor       =   &H00808080&
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   282
      Left            =   3000
      TabIndex        =   16
      Top             =   1030
      Width           =   3495
   End
   Begin VB.Label Label8 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackColor       =   &H00808080&
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   225
      Left            =   6435
      TabIndex        =   15
      Top             =   1080
      Width           =   2820
   End
   Begin VB.Label Label7 
      BackColor       =   &H00808080&
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3000
      TabIndex        =   14
      Top             =   960
      Width           =   6255
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      Height          =   2055
      Left            =   3000
      Top             =   1400
      Width           =   6255
   End
   Begin VB.Menu mnu0File 
      Caption         =   "&File"
      Begin VB.Menu Mnu0New 
         Caption         =   "&New"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnu0Open 
         Caption         =   "&Open"
      End
      Begin VB.Menu mnu0SaveAs 
         Caption         =   "S&ave As"
      End
      Begin VB.Menu sep 
         Caption         =   "-"
      End
      Begin VB.Menu mnu0Print 
         Caption         =   "Print..."
      End
      Begin VB.Menu mnu0Rubbish 
         Caption         =   "Empty Rubbish Bin"
      End
      Begin VB.Menu sep2 
         Caption         =   "-"
      End
      Begin VB.Menu Mnu0Close 
         Caption         =   "Close"
         Shortcut        =   ^X
      End
   End
   Begin VB.Menu mnu0Edit 
      Caption         =   "&Edit"
      Begin VB.Menu mnu0Del 
         Caption         =   "Delete"
      End
      Begin VB.Menu sep4 
         Caption         =   "-"
      End
      Begin VB.Menu Mnu0NewFold 
         Caption         =   "&New Folder"
      End
      Begin VB.Menu Mnu0MvFold 
         Caption         =   "&Move to Folder"
      End
   End
   Begin VB.Menu mnu0View 
      Caption         =   "&View"
      Begin VB.Menu Mnu0Preview 
         Caption         =   "Preview Pa&ne"
      End
      Begin VB.Menu mnu0Opt 
         Caption         =   "O&ptions                 "
      End
   End
   Begin VB.Menu mnu4Tools 
      Caption         =   "&Tools"
      Begin VB.Menu mnu4Reindex 
         Caption         =   "Compress Database"
      End
      Begin VB.Menu mnu4EmailAcc 
         Caption         =   "Email Properties"
      End
   End
   Begin VB.Menu mnu0Help 
      Caption         =   "&Help"
      Begin VB.Menu mnu0About 
         Caption         =   "A&bout Office Messenger"
      End
   End
   Begin VB.Menu Menu1 
      Caption         =   "mnu"
      Visible         =   0   'False
      Begin VB.Menu mnuNew 
         Caption         =   "&New Message"
      End
      Begin VB.Menu mnuRefresh 
         Caption         =   "&Refresh List:"
      End
      Begin VB.Menu MnuInfo 
         Caption         =   "User Information"
      End
      Begin VB.Menu Menu2 
         Caption         =   "Mnu2"
         Visible         =   0   'False
         Begin VB.Menu Mnu2Open 
            Caption         =   "&Open"
         End
         Begin VB.Menu MnuNewFold 
            Caption         =   "&New Folder"
         End
         Begin VB.Menu sep3 
            Caption         =   "-"
         End
         Begin VB.Menu MnuDelFolder 
            Caption         =   "D&elete Folder"
         End
         Begin VB.Menu Mnu2Rubbish 
            Caption         =   "Empty Rubbish Bin"
         End
      End
   End
   Begin VB.Menu Menu3 
      Caption         =   "mnu3"
      Visible         =   0   'False
      Begin VB.Menu mnu3Open 
         Caption         =   "Open"
      End
      Begin VB.Menu mnu3Print 
         Caption         =   "Print"
      End
      Begin VB.Menu mnuReply 
         Caption         =   "Reply"
      End
      Begin VB.Menu sep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnu3Delete 
         Caption         =   "Delete"
      End
      Begin VB.Menu mnu3Move 
         Caption         =   "&Move to Folder..."
      End
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const GWL_STYLE = (-16)
Private Const LVM_FIRST = &H1000
Private Const LVM_GETHEADER = (LVM_FIRST + 31)
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 55
Private Const LVS_EX_FULLROWSELECT = &H20
Private Const HDS_BUTTONS = &H2
  
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Offline As Boolean ' work offline detection if true then read cache
Public Logged, MailIcon As Boolean
Public strMessage As String
Public AllUsersList As String 'get all the users in a variable, will come in handy
Public DragMessage As String 'Get the information when dragging a message
Dim TC As NOTIFYICONDATA
Public Selected As String
Public HiddenPreview As Boolean
Public ColumnSet As String
Public ATFiles As Boolean
'Public Lvstore As MsgLayout
Public OFMSGER As MsgLayout



Private Sub Frame1_Click()
RichTextBox1_GotFocus
End Sub

Private Sub HSplit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Res As Long
HSplit.BackColor = vbBlack

ReleaseCapture
On Error Resume Next
        Res = SendMessage(HSplit.hwnd, WM_SYSCOMMAND, 61458, 0)
         HSplit.BackColor = vbButtonFace

         If HSplit.Top < 1500 Then HSplit.Top = 2400
         If HSplit.Top > FrmMain.Height - 2000 Then HSplit.Top = FrmMain.Height - 3000
         LvMail.Height = HSplit.Top - 1410
         Shape1.Height = HSplit.Top - 1410
         
         Frame1.Top = HSplit.Top - 20
         HSplit.Width = Frame1.Width
         HSplit.Left = Frame1.Left
         RichTextBox1.Height = FrmMain.Height - LvMail.Height - 3080
         RichTextBox1.Top = HSplit.Top + 720

End Sub

Private Sub ctlSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Res As Long
ctlSplitter.BackColor = vbBlack
DoEvents
ReleaseCapture

On Error Resume Next
        Res = SendMessage(ctlSplitter.hwnd, WM_SYSCOMMAND, 61458, 0)
         ctlSplitter.BackColor = vbButtonFace
         If ctlSplitter.Left > 9180 Then ctlSplitter.Left = 9000
         If ctlSplitter.Left < 2675 Then ctlSplitter.Left = 2700
         If HSplit.Top < 1500 Then HSplit.Top = 2500
         LvMail.Left = ctlSplitter.Left + 60
         Shape1.Left = ctlSplitter.Left + 60
         Frame1.Left = ctlSplitter.Left + 60
         Label7.Left = ctlSplitter.Left + 60
         Label9.Left = ctlSplitter.Left + 60
         
         Label6.Width = FrmMain.Width - ctlSplitter.Left - 5300
         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
         
         TVdir.Width = ctlSplitter.Left
         TVcontact.Width = ctlSplitter.Left
         HSplit.Left = ctlSplitter.Left + 60
         ctlSplitter.Top = TVdir.Top
         RichTextBox1.Left = ctlSplitter.Left + 60
         LvMail.Width = FrmMain.Width - ctlSplitter.Left - 260
         Shape1.Width = FrmMain.Width - ctlSplitter.Left - 260
         
         RichTextBox1.Width = FrmMain.Width - ctlSplitter.Left - 285
         Frame1.Width = FrmMain.Width - ctlSplitter.Left - 275
         LvMail.ColumnHeaders.Item(3).Width = FrmMain.Width - ctlSplitter.Left - 4340
       
End Sub


Private Sub Form_Load()

'Remove these few lines if you deside to have your own personal name saved.

DoEvents
SaveRegKey HKEY_CURRENT_USER, "OfficeMessenger", "UserName", "Chris Hatton"
DoEvents
SaveRegKey HKEY_CURRENT_USER, "OfficeMessenger", "Password", "Password"
DoEvents
SaveRegKey HKEY_CURRENT_USER, "OfficeMessenger", "SavePassword", "True"
'remove


If GetRegKey(HKEY_CURRENT_USER, "OfficeMessenger", "AutoLogon", "") = "True" Then Call GetConnection
If GetRegKey(HKEY_CURRENT_USER, "OfficeMessenger", "HidePreview", "") = "True" Then Call FrmStyle: Mnu0Preview.Checked = False Else:  Mnu0Preview.Checked = True


Call GetConnection
Me.WindowState = vbMinimized
DisControls True
Label8.Caption = Format(Now, "long Date")
Label9.Caption = "  Inbox Folder"
Me.Caption = "  Inbox Folder - " & "Office Messenger"
'SendMessage HSplit.hWnd, &HF4&, &H8&, 0&
'SendMessage ctlSplitter.hWnd, &HF4&, &H8&, 0&
'Set Lvstore = New MsgLayout
End Sub

Sub lvcolumns()
LvMail.View = lvwReport

With LvMail.ColumnHeaders
    
    .Add , , , 280
    .Add , , "From", 1500
    .Add , , "Subject", 8250
    .Add , , "Received", 1830
    .Add , , , 180  'blank '5
   
    .Item(5).Position = 1
    
End With
435
Dim hHeader As Long
    hHeader = SendMessage(LvMail.hwnd, LVM_GETHEADER, 0, ByVal 0&)
    SetWindowLong hHeader, GWL_STYLE, GetWindowLong(hHeader, GWL_STYLE) Xor HDS_BUTTONS

End Sub

Private Sub Form_Resize()
On Error Resume Next

'If HSplit.Top < 1800 Then Me.Height = 6500

         
Label7.Left = ctlSplitter.Left + 60
LvMail.Width = FrmMain.Width - 3150
Shape1.Width = FrmMain.Width - 3150
Label7.Width = FrmMain.Width - 3150
'LvMail.ColumnHeaders.Item(3).Width = FrmMain.Width - 6980
CoolBar1.Width = FrmMain.Width - 160
Frame1.Width = FrmMain.Width - 3100
DoEvents
If Not HiddenPreview = True Then RichTextBox1.Height = FrmMain.Height - 600
'If Not HiddenPreview = True Then LvMail.Height = HSplit.Top - 1430
'If Not HiddenPreview = True Then Shape1.Height = HSplit.Top - 1430
If HiddenPreview = True Then LvMail.Height = FrmMain.Height - 2340
If HiddenPreview = True Then Shape1.Height = FrmMain.Height - 2340

DoEvents
Label6.Width = FrmMain.Width - 8100
DoEvents
'RichTextBox1.Width = FrmMain.Width - 2500
DoEvents
TVcontact.Height = FrmMain.Height - 4430
DoEvents
HSplit.Width = Frame1.Width
DoEvents
HSplit.Left = Frame1.Left
DoEvents
ctlSplitter.Height = FrmMain.Height - 1900
DoEvents
If Not HSplit.Top <= 2000 Then HSplit.Top = FrmMain.Height - 4500
If Me.Height < 6800 Then HSplit.Top = 2100
'Frame1.Top = HSplit.Top + 100

        If Not HiddenPreview = True Then LvMail.Height = HSplit.Top - 1430
         If Not HiddenPreview = True Then Shape1.Height = HSplit.Top - 1430

         Frame1.Top = HSplit.Top - 20
         DoEvents
         RichTextBox1.Height = FrmMain.Height - LvMail.Height - 3090
         RichTextBox1.Top = HSplit.Top + 720
         ctlSplitter.Top = TVdir.Top