form6.frm

用vb编的网络聊天程序

VERSION 5.00
Begin VB.Form Form6 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Chat"
   ClientHeight    =   3255
   ClientLeft      =   5880
   ClientTop       =   1800
   ClientWidth     =   5100
   Icon            =   "Form6.frx":0000
   LinkTopic       =   "Form6"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3255
   ScaleWidth      =   5100
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Command1 
      Caption         =   "&Send"
      Height          =   300
      Left            =   3852
      TabIndex        =   1
      Top             =   2700
      Width           =   1020
   End
   Begin VB.TextBox Text2 
      Height          =   300
      Left            =   108
      TabIndex        =   0
      Text            =   "Text2"
      Top             =   2700
      Width           =   3612
   End
   Begin VB.TextBox Text1 
      Height          =   2316
      Left            =   108
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Text            =   "Form6.frx":000C
      Top             =   144
      Width           =   4764
   End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'add line without memory overflow
Private Sub AddLine(LineStr As Variant)
    If Text1.SelStart >= 16384 Then
        Text1.SelStart = 0
        Text1.SelLength = 8192
        Text1.SelText = vbNullString
    End If
    Text1.SelStart = 65535
    If Len(LineStr) >= 16384 Then
        Text1.SelText = Mid$(LineStr, 8192)
    Else
        Text1.SelText = LineStr
    End If
End Sub


Private Sub SendText()

    On Error GoTo ErrorHandle
    Dim s As String
    s = Text2.Text
    If Len(s) <= 0 Then Exit Sub
    
    'tell remote our sentence
    Form1.SendMessage -1, -1, TM_CHATDATA, , s
    
    'reset textbox
    Text2 = vbNullString

    'add to chat
    AddChat gstrMyName, s
    Exit Sub
    
ErrorHandle:
    
End Sub

Private Sub Command1_Click()
    On Error GoTo ErrorHandle
    SendText
    Text2.SetFocus
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub

Private Sub Form_Activate()
    On Error GoTo ErrorHandle
    Text2.SetFocus
ErrorHandle:
End Sub

Private Sub Form_Load()
    On Error GoTo ErrorHandle
    Text1 = vbNullString
    Text1.Locked = True
    
    Text2 = vbNullString
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    On Error GoTo ErrorHandle
    If KeyAscii = vbKeyReturn Then KeyAscii = 0: SendText
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub


Private Sub AddChat(User As String, Content As Variant)
    AddLine User & ":" & vbCrLf & "  " & Content & vbCrLf & vbCrLf
End Sub


Friend Sub OnMessage(Host As String, ByVal Address As Long, ByVal Port As Integer, ByVal Handle As Long, ByVal Param As Long, Data As Variant)
    Select Case Handle
    Case TM_CHATDATA
    
        'new sentence
        AddChat Host, Data
        
        If Not Visible Then Show vbModeless, Form1
    End Select
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error GoTo ErrorHandle
    If UnloadMode <> vbFormCode Then
        Hide
        Cancel = True
    End If
    Exit Sub
    
ErrorHandle:
    ShowErr
End Sub