frmnew.frm

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

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   975
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "To:"
      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        =   3
      Top             =   615
      Width           =   855
   End
   Begin VB.Menu mnufile 
      Caption         =   "&File"
      Begin VB.Menu mnuNew 
         Caption         =   "&New"
         WindowList      =   -1  'True
         Begin VB.Menu MnuSNew 
            Caption         =   "Mail Message"
         End
      End
      Begin VB.Menu mnuSendF 
         Caption         =   "&Send"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuEmail 
         Caption         =   "S&end via Email"
         Shortcut        =   ^E
      End
      Begin VB.Menu mnuSave 
         Caption         =   "Sa&ve As"
      End
      Begin VB.Menu Sep1 
         Caption         =   "-"
      End
      Begin VB.Menu MnuDelete 
         Caption         =   "Delete"
         Shortcut        =   {DEL}
      End
      Begin VB.Menu mnuMove 
         Caption         =   "Move to Folder"
         Shortcut        =   ^M
      End
      Begin VB.Menu mnuPrint 
         Caption         =   "&Print"
         Shortcut        =   ^P
      End
      Begin VB.Menu sep2 
         Caption         =   "-"
      End
      Begin VB.Menu MnuClose 
         Caption         =   "Close"
         Shortcut        =   ^{F4}
      End
   End
End
Attribute VB_Name = "FrmNew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer
Dim ATFlist As String
Public MsgItm As Long

Private Sub Form_Load()
'LVFiles.ColumnHeaders.Add , , "File Attachments", 1000
'Me.Height = FrmMain.Height - 2000

End Sub

Private Sub Form_Resize()
On Error Resume Next
RichTextBox1.Width = Me.Width - 100
RichTextBox1.Height = Me.Height - 2600
Text1(0).Width = Me.Width - 1260
Text1(1).Width = Me.Width - 1260
Combo1.Width = Me.Width - 1260
CoolBar1.Width = Me.Width - 100
LVFiles.Width = Me.Width - 100
LVFiles.Height = Me.Height - 6000
If FrmMain.ATFiles = True Then RichTextBox1.Height = Me.Height - 3900
If FrmMain.ATFiles = True Then LVFiles.Visible = True
If FrmMain.ATFiles = True Then LVFiles.Top = Me.Height - 2000
If LVFiles.Height < 2000 Then LVFiles.Height = 1595
Label4.Left = Me.Width - 2500
LVFiles.ColumnHeaders.Item(1).Width = FrmMain.Width
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub

Private Sub LVFiles_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
LVFiles.ToolTipText = Split(LVFiles.SelectedItem.Text, "\")(UBound(Split(LVFiles.SelectedItem.Text, "\")))
End Sub

Private Sub MnuClose_Click()
Unload Me
End Sub

Private Sub mnuCopy_Click()
SendKeys "^c"

End Sub

Private Sub mnuCut_Click()
SendKeys "^x"
End Sub

Private Sub MnuDelete_Click()
Call FrmMain.ItmDelete
Unload Me
End Sub

Private Sub mnuEmail_Click()
    FrmConnect.Usersock.SendData "Email" & FrmConnect.strUserName & Chr(10) & _
    Text1(0).Text & "~~" & Combo1.Text & "~~" & Text1(1).Text & "~~" & _
    RichTextBox1.Text & "[~N10~]" & "~~" & Date
    
Unload Me

End Sub

Private Sub mnuMove_Click()
'from ' subject 'date ' id ' message ' whofrom
FrmMain.DragMessage = Text1(0).Text & "~~" & Text1(1) & "~~" & Label4.Caption & "~~" & MsgItm & "~~" & Split(RichTextBox1.Text, "[~N10~]")(0) & "~~" & FrmConnect.strUserName
Call FrmMain.DragFolder

End Sub

Private Sub mnuPaste_Click()
SendKeys "^v"

End Sub
Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
If ButtonMenu.Index = 1 Then
    
    FrmConnect.Usersock.SendData "Email" & FrmConnect.strUserName & Chr(10) & _
    Text1(0).Text & "~~" & Combo1.Text & "~~" & Text1(1).Text & "~~" & _
    RichTextBox1.Text & "[~N10~]" & "~~" & Date
    End If
Unload Me
End Sub

Private Sub mnuPrint_Click()
Call PrintMsg
End Sub

Private Sub mnuSendF_Click()
Call SendMessage
End Sub

Private Sub MnuSNew_Click()
FrmMain.CreateNew
End Sub
Private Sub mnuUndo_Click()
SendKeys "^z"
End Sub

Private Sub RichTextBox1_Click()
If Toolbar1.Buttons(4).Enabled = True Then Unload Me: Call FrmMain.Reply
End Sub



Private Sub Timer1_Timer()

On Error Resume Next
If FrmMain.ATFiles = True Then RichTextBox1.Height = Me.Height - 3900
If FrmMain.ATFiles = True Then LVFiles.Visible = True
If FrmMain.ATFiles = True Then LVFiles.Top = Me.Height - 2000
If LVFiles.Height < 2000 Then LVFiles.Height = 1595

If FrmMain.ATFiles = True Then LVFiles.Visible = True
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index

Case 1: Call SendMessage
Case 3: Call PrintMsg
Case 4: Unload Me: Call FrmMain.Reply

End Select


End Sub
Sub SendMessage()
'newmessageFROM~~TO~~SUBJECT~~MESSAGE
Dim j As Integer

If Combo1.Text = "" Then
    MsgBox "There must be a name in the TO: field", vbExclamation + vbOKOnly, "Send Message"
Exit Sub
End If

If Text1(0).Text = "" Then
    MsgBox "There must be a name in the From: field", vbExclamation + vbOKOnly, "Send Message"
Exit Sub
End If

'If RichTextBox1.Text = "" Then
 '   MsgBox "No blank messages allowed.", vbExclamation + vbOKOnly, "Send Message"
'Exit Sub
'End If

FrmConnect.Usersock.SendData "NewMessage" & Text1(0).Text & _
"~~" & Combo1.Text & "~~" & Text1(1).Text & "~~" & RichTextBox1.Text & "[~N10~]" & "~~" & Date & Chr(10)

Unload Me
End Sub

Sub PrintMsg()
Dim FrmPrinter As FrmPrint
Set FrmPrinter = New FrmPrint
    
        FrmPrinter.Label1.Caption = Text1(0).Text
        FrmPrinter.Label2.Caption = "Subject: " & Text1(1).Text
        FrmPrinter.RichTextBox1.Text = RichTextBox1.Text
        Const ErrCancel = 32755
            FrmMain.PrintDiag.CancelError = True
            
            On Error GoTo errorPrinter
                FrmMain.PrintDiag.Flags = 64
                FrmMain.PrintDiag.ShowPrinter
                FrmPrinter.PrintForm

        Set FrmPrinter = Nothing
       

errorPrinter:
            If Err = ErrCancel Then
        
        
    Set FrmPrinter = Nothing

        Exit Sub
            End If
End Sub