privatechat.frm

用Delphi写的网络聊天工具

      micon           =   "PrivateChat.frx":143AA
      picn            =   "PrivateChat.frx":143C8
      umcol           =   -1  'True
      soft            =   0   'False
      picpos          =   2
      ngrey           =   0   'False
      fx              =   0
      hand            =   0   'False
      check           =   0   'False
      value           =   0   'False
   End
   Begin MynetChat.chameleonButton cmdGroup 
      Height          =   330
      Left            =   4680
      TabIndex        =   15
      TabStop         =   0   'False
      ToolTipText     =   "黑客群信息"
      Top             =   3375
      Width           =   375
      _extentx        =   661
      _extenty        =   582
      btype           =   8
      tx              =   ""
      enab            =   -1  'True
      font            =   "PrivateChat.frx":14854
      coltype         =   2
      focusr          =   0   'False
      bcol            =   15463924
      bcolo           =   15463924
      fcol            =   0
      fcolo           =   0
      mcol            =   12632256
      mptr            =   1
      micon           =   "PrivateChat.frx":1487C
      picn            =   "PrivateChat.frx":1489A
      umcol           =   -1  'True
      soft            =   0   'False
      picpos          =   2
      ngrey           =   0   'False
      fx              =   0
      hand            =   0   'False
      check           =   0   'False
      value           =   0   'False
   End
   Begin MynetChat.MyButton cmdBold 
      Height          =   345
      Left            =   240
      TabIndex        =   16
      ToolTipText     =   "粗体"
      Top             =   3420
      Width           =   315
      _extentx        =   556
      _extenty        =   609
      spn             =   "MyButtonDefSkin"
      font            =   "PrivateChat.frx":14B3A
      picture         =   "PrivateChat.frx":14B62
      picturepos      =   4
   End
   Begin MynetChat.MyButton cmdItalic 
      Height          =   345
      Left            =   600
      TabIndex        =   17
      ToolTipText     =   "斜体"
      Top             =   3420
      Width           =   315
      _extentx        =   556
      _extenty        =   609
      spn             =   "MyButtonDefSkin"
      font            =   "PrivateChat.frx":14F90
      picture         =   "PrivateChat.frx":14FB8
      picturepos      =   4
   End
   Begin MynetChat.MyButton cmdUnderline 
      Height          =   345
      Left            =   960
      TabIndex        =   18
      ToolTipText     =   "下划线"
      Top             =   3420
      Width           =   315
      _extentx        =   556
      _extenty        =   609
      spn             =   "MyButtonDefSkin"
      font            =   "PrivateChat.frx":15052
      picture         =   "PrivateChat.frx":1507A
      picturepos      =   4
   End
   Begin MynetChat.chameleonButton cmdemoticons 
      Height          =   375
      Left            =   1905
      TabIndex        =   21
      TabStop         =   0   'False
      ToolTipText     =   "表情"
      Top             =   3375
      Width           =   495
      _extentx        =   873
      _extenty        =   661
      btype           =   8
      tx              =   ""
      enab            =   -1  'True
      font            =   "PrivateChat.frx":1511C
      coltype         =   2
      focusr          =   0   'False
      bcol            =   15463924
      bcolo           =   15463924
      fcol            =   0
      fcolo           =   0
      mcol            =   12632256
      mptr            =   1
      micon           =   "PrivateChat.frx":15144
      picn            =   "PrivateChat.frx":15162
      umcol           =   -1  'True
      soft            =   0   'False
      picpos          =   2
      ngrey           =   0   'False
      fx              =   0
      hand            =   0   'False
      check           =   0   'False
      value           =   0   'False
   End
   Begin MynetChat.chameleonButton cmdFtp 
      Height          =   375
      Left            =   2520
      TabIndex        =   22
      TabStop         =   0   'False
      ToolTipText     =   "文件传输"
      Top             =   3360
      Width           =   1335
      _extentx        =   2355
      _extenty        =   661
      btype           =   8
      tx              =   "发送文件    "
      enab            =   -1  'True
      font            =   "PrivateChat.frx":1562A
      coltype         =   2
      focusr          =   0   'False
      bcol            =   15463924
      bcolo           =   15463924
      fcol            =   0
      fcolo           =   0
      mcol            =   12632256
      mptr            =   1
      micon           =   "PrivateChat.frx":1564E
      picn            =   "PrivateChat.frx":1566C
      umcol           =   -1  'True
      soft            =   0   'False
      picpos          =   0
      ngrey           =   0   'False
      fx              =   0
      hand            =   0   'False
      check           =   0   'False
      value           =   0   'False
   End
   Begin VB.Line Line6 
      BorderColor     =   &H00EBF5F4&
      Index           =   1
      X1              =   96
      X2              =   6
      Y1              =   252
      Y2              =   252
   End
   Begin VB.Line Line6 
      BorderColor     =   &H00FFFFFF&
      Index           =   0
      X1              =   450
      X2              =   258
      Y1              =   223
      Y2              =   223
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00BAB6B3&
      Height          =   360
      Left            =   105
      Top             =   3780
      Width           =   5715
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00BAB6B3&
      Height          =   2655
      Left            =   105
      Top             =   705
      Width           =   6675
   End
   Begin VB.Label lblbytestransferred 
      Caption         =   "Label3"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   4920
      Width           =   1935
   End
   Begin VB.Shape Shape7 
      BackColor       =   &H00BAB6B3&
      BorderColor     =   &H00BAB6B3&
      Height          =   390
      Index           =   0
      Left            =   3885
      Top             =   3345
      Width           =   2895
   End
   Begin VB.Shape Shape7 
      BackColor       =   &H00BAB6B3&
      BorderColor     =   &H00BAB6B3&
      Height          =   405
      Index           =   1
      Left            =   105
      Top             =   3390
      Width           =   1335
   End
End
Attribute VB_Name = "PrivateChat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：05/08/03
'描    述：我的网络聊天室 (客户端)
'网    站：http://www.mndsoft.com/
'e-mail  ：[e-mail]
'OICQ    ：88382850
'****************************************************************************
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2

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 Const WM_PASTE = &H302

'Round the form
Dim rndfrm As New ROUND_FORM

'color variables
Dim name_color, message_color, hyper_color, back_color As Ole_Color

Dim start As Integer
Dim newstart As Integer

Dim MESSAGE As String
Dim nickis As String
Dim countnudge As Integer

Dim i As Integer
Dim temp As Integer
Dim emotfind As Integer
Dim G_startfrom  As Long

Dim x_fontname As String
Dim x_IsItalic As Boolean
Dim x_IsBold As Boolean

Private Sub cmdBold_Click()
txtmessage.Font.Bold = Not txtmessage.Font.Bold
End Sub

Private Sub cmdClear_Click()
txtchat.Text = ""
newstart = 0
G_startfrom = 0
End Sub

Private Sub cmdClose_Click()
'CPC = CLOSE PRVATE CHAT
privateclient.SendData "CPC:"
DoEvents
End Sub

Private Sub cmdemoticons_Click()
frmEmot.Show
End Sub

Private Sub cmdFont_Click()
frmFonts.Show
frmFonts.FormObjectHandle = Me
End Sub

Private Sub cmdFtp_Click()
frmSender.Visible = True
frmSender.txtRemoteHost.Clear
'fill combo with usernames
Dim i As Integer
For i = 1 To Client.lstusers.ListCount - 1
    frmSender.txtRemoteHost.AddItem Client.lstusers.List(i)
Next
frmSender.txtRemoteHost.AddItem " "
End Sub

Private Sub cmdGroup_Click()
Group.Show 1
End Sub

Private Sub cmdItalic_Click()
txtmessage.Font.Italic = Not txtmessage.Font.Italic
End Sub

Private Sub cmdPrivateChat_Click()
privateclient.SendData ":NUDGE"
DoEvents
End Sub

Private Sub cmdUnderline_Click()
txtmessage.Font.Underline = Not txtmessage.Font.Underline
End Sub

Private Sub Form_Load()
txtmessage.SelStart = Len(txtmessage.Text)
'round form shape
rndfrm.ROUND_FORM Me, 12, 1, 1

G_startfrom = 1
txtchat.SelColor = vbBlack
name_color = namecolor.BackColor
message_color = messagecolor.BackColor
hyper_color = hypercolor.BackColor

End Sub

Private Sub Form_Unload(Cancel As Integer)
'CPC = CLOSE PRVATE CHAT
privateclient.SendData "CPC:"
DoEvents
End Sub

Private Sub privateclient_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
'SAVE MESSAGE BUFFER IN MESSAGE
privateclient.GetData MESSAGE

If MESSAGE = "CPC:" Then
    Unload Me
    Exit Sub
End If
If MESSAGE = ":NUDGE" Then
    PLAY_SOUND "nudge"
    NUDGE_ME
    Timer1.Enabled = True
    Exit Sub
'IF IT IS A MESSAGE FROM SERVER
Else
    txtchat.SelFontName = FontNameIs
    txtchat.SelItalic = IsItalic
    txtchat.SelBold = IsBold
    txtchat.SelUnderline = False
    txtchat.SelStart = Len(txtchat.Text)
    newstart = Len(txtchat.Text)
    txtchat.SelText = MESSAGE
    COLORTEXT
    'set the selstart
    txtchat.SelStart = Len(txtchat.Text)
    txtchat.SelText = vbCrLf
    
    newstart = Len(txtchat.Text)
End If

MESSAGE = ""