frmchat.frm

能用的网吧计费管理系统(客户端).zip

Case "很无辜"
tBiaoQing = "很无辜的说"

Case "喃喃自语"
tBiaoQing = "喃喃自语的说"

Case "瞪眼"
tBiaoQing = "恶狠狠的瞪着眼说"

Case "想吐"
tBiaoQing = "快要吐的说"

Case "不舒服"
tBiaoQing = "不舒服的说"

Case "无精打采"
tBiaoQing = "无精打采的说"

Case "依依不舍"
tBiaoQing = "依依不舍的说"

Case "白沫"
tBiaoQing = "吐白沫着说"
Case "狂喜"
tBiaoQing = "掩饰不住狂喜的心情，说"
Case "拱手"
tBiaoQing = "笑呵呵一拱手，说"
Case "作揖"
tBiaoQing = "很有礼貌地作了一揖，说"
Case "慨叹"
tBiaoQing = "咳!慨叹万千的说"
Case "致歉"
tBiaoQing = "很不好意思地致歉，说"
Case "伤感"
tBiaoQing = "望着窗外细雨淅淅，不由得双眼朦胧"
Case "含泪"
tBiaoQing = "含泪要哭，说"
Case "大哭"
tBiaoQing = "想到伤心处，泪流如注，说"
Case "痛哭"
tBiaoQing = "抱头放声大哭，说"
Case "害怕"
tBiaoQing = "好怕怕呀..."
Case "奇特"
tBiaoQing = "感到很是奇特，说"
Case "眯眼"
tBiaoQing = "眯着小眼睛道"
Case "大方"
tBiaoQing = "咯咯一笑，很大方的说"
Case "脸红"
tBiaoQing = "脸上泛起了红晕，说"
 
Case "生气"
tBiaoQing = "气愤的嚷道"
Case "大声"
tBiaoQing = "提高嗓门说"
Case "断喝"
tBiaoQing = "运足气一声断喝"
Case "迷茫"
tBiaoQing = "一脸的迷茫的说"
Case "耸肩"
tBiaoQing = "无奈地耸耸肩，说"
Case "拍脑"
tBiaoQing = "使劲敲敲自己脑门说"
Case "无聊"
tBiaoQing = "看着别人谈笑，无聊的很,说"
Case "沉思"
tBiaoQing = "故作沉思状的说"
Case "无辜"
tBiaoQing = "一付无辜的样子，说"
Case "不适"
tBiaoQing = "不舒服的说"

End Select


frmButton.Winsock1.SendData "_talk" + Chr(0) + "talk" + Chr(0) + mThisName + Chr(0) + mThisSex + Chr(0) + cmbSelectUser.Text + Chr(0) _
                           + UserList.SelectedItem.Text + Chr(0) + cmbShiYang.Text + Chr(0) + cmbFontName.Text + Chr(0) _
                           + cmbFontSize + Chr(0) + tColor + Chr(0) _
                           + tBiaoQing + Chr(0) + Text1.Text
                           

Text1.Text = ""
End Sub

Private Sub Form_Load()
On Error Resume Next
'Me.Show
'frmCharUser.Show vbModal, Me
If IsLogin = False Then Exit Sub
Form_Resize
UserList.ListItems.Clear
lblUseName = mThisName
AddUserName "大家", ""
'AddUserName mThisName, mThisSex
 cmbFontName.AddItem " 选择字体"
For i = 1 To Screen.FontCount
If Screen.Fonts(i) <> "" Then
 cmbFontName.AddItem Screen.Fonts(i)
End If
Next i
cmbFontName = RTBox1.Font.Name
cmbFontSize = Round(RTBox1.Font.Size, 0)
cmbShiYang.Text = "公开的"
cmbFontColor.Text = cmbFontColor.List(0)
Form_Resize
End Sub

Private Sub Form_Resize()
On Error Resume Next
Frame1.Top = Me.Height - StatusBar1.Height - Frame1.Height - 400
Frame1.Width = Me.Width - 120
RTBox1.Height = Frame1.Top
RTBox1.Width = Me.Width - UserList.Width - 200
imgLine.Left = RTBox1.Width + RTBox1.Left
UserList.Left = imgLine.Left + imgLine.Width
imgLine.Height = RTBox1.Height
UserList.Height = RTBox1.Height
UserList.Width = Me.Width - UserList.Left - 120
Frame2.Left = Frame1.Left + Frame1.Width - Frame2.Width
cmbShiYang.Left = lblUseName.Left + lblUseName.Width + 50
Label1.Left = cmbShiYang.Left + cmbShiYang.Width
cmbSelectUser.Left = Label1.Left + Label1.Width
Label2.Left = cmbSelectUser.Left + cmbSelectUser.Width
Image1.Left = Label2.Left + Label2.Width
Text1.Left = Image1.Left + Image1.Width
Command1.Left = Frame2.Left - Command1.Width
Image2.Left = Command1.Left - Image2.Width
Text1.Width = Image2.Left - Text1.Left
End Sub

Private Sub Form_Unload(Cancel As Integer)
'If MsgBox("确实要退出聊天室吗？", vbYesNo + vbQuestion + vbSystemModal) = vbNo Then
' Cancel = True
' Exit Sub
'End If
If mThisName <> "" Then
 frmButton.Winsock1.SendData "_talk" + Chr(0) + "quit" + Chr(0) + mThisName + Chr(0) + mThisSex
End If
End Sub

Private Sub imgLine_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 And (X < 0 Or UserList.Width >= 2000) And (X > 0 Or RTBox1.Width >= 6000) Then
  RTBox1.Width = RTBox1.Width + X
  imgLine.Left = RTBox1.Width + RTBox1.Left
  UserList.Left = imgLine.Left + imgLine.Width
  UserList.Width = Me.Width - UserList.Left - 120
End If
End Sub



Sub AddUserName(xName As String, xSex As String)
'add user
'UserList.ListItems.Add 1, , "大家", , 3
Select Case xSex
Case "男生"
b = 1
Case "女生"
b = 2
Case Else
b = 3
End Select
aa = UserList.ListItems.Count + 1
UserList.ListItems.Add aa, , xSex, , b
UserList.ListItems(aa).SubItems(1) = xName
'userlist.ListItems(1).
'UserList.ListItems.Add 2, , "小姐", , 2
cmbSelectUser.AddItem mThisName
UserList.Refresh
End Sub


Public Sub XianShi(iStr As String)
'显示
On Error Resume Next
Dim thisStr(11) As String, cc As Long
cc = 0
For i = 1 To Len(iStr)
  a$ = Mid(iStr, i, 1)
  If a$ = Chr(0) Then
   cc = cc + 1
  Else
   thisStr(cc) = thisStr(cc) + a$
  End If
Next i
Select Case thisStr(1)
Case "talk"
  RTBox1.SelStart = Len(RTBox1.Text)
  If mThisName <> thisStr(2) And mThisName <> thisStr(4) And thisStr(4) <> "大家" And thisStr(6) <> "公开的" Then
   Exit Sub
  End If
  oldcolor = RTBox1.SelColor
   If thisStr(6) <> "公开的" Then
    
      RTBox1.SelStart = Len(RTBox1.Text)
      If thisStr(6) = "强调密" Then RTBox1.SelItalic = True
      RTBox1.SelText = "→※"
   End If
        RTBox1.SelStart = Len(RTBox1.Text)
        RTBox1.SelText = Format(Time, "HH:NN:SS")
   length = Len(RTBox1.Text)
   RTBox1.SelStart = length
   Select Case thisStr(3)
     Case "男生"
     RTBox1.SelColor = &HFF0000
     Case "女生"
     RTBox1.SelColor = &HFF
     Case Else
     RTBox1.SelColor = &H50B000
   End Select
      
   RTBox1.SelText = thisStr(2)
 
   length = Len(RTBox1.Text)
   RTBox1.SelStart = length
   RTBox1.SelColor = oldcolor

    RTBox1.SelText = "对"
   length = Len(RTBox1.Text)
   RTBox1.SelStart = length

   Select Case thisStr(5)
     Case "男生"
     RTBox1.SelColor = &HFF0000
     Case "女生"
     RTBox1.SelColor = &HFF
     Case Else
     RTBox1.SelColor = &H50B000
   End Select
      RTBox1.SelText = thisStr(4)
      
   length = Len(RTBox1.Text)
   RTBox1.SelStart = length
   RTBox1.SelColor = oldcolor
   RTBox1.SelText = thisStr(10) & "："
   length = Len(RTBox1.Text)
   RTBox1.SelStart = length

   RTBox1.SelFontName = thisStr(7)
   RTBox1.SelFontSize = Val(thisStr(8))
   RTBox1.SelColor = Val(thisStr(9))
   RTBox1.SelText = thisStr(11)
   
     
   RTBox1.SelStart = Len(RTBox1.Text)
   RTBox1.SelFontName = RTBox1.Font.Name
   RTBox1.SelFontSize = RTBox1.Font.Size
   RTBox1.SelItalic = False
   RTBox1.SelColor = oldcolor
   RTBox1.SelText = vbCrLf
Case "login" '如果是
 If thisStr(2) = "" Then
   mThisName = ""
   
   Unload Me
  
   MsgBox "这个用户名已经有人用了，请你换个名字再进一次！", vbExclamation + vbSystemModal
  
   frmCharUser.Show
   Exit Sub

  Else
        RTBox1.SelStart = Len(RTBox1.Text)
    oldcolor = RTBox1.SelColor
    Select Case thisStr(3)
     Case "男生"
     RTBox1.SelColor = &HFF0000
     Case "女生"
     RTBox1.SelColor = &HFF
     Case Else
     RTBox1.SelColor = &H50B000
   End Select
   RTBox1.SelText = thisStr(2) + " "
   RTBox1.SelStart = Len(RTBox1.Text)
   RTBox1.SelColor = 3
   RTBox1.SelText = "漫步来到聊天室，高兴的对大家说“嗨~~~！我来了~~~！" + vbCrLf
   AddUserName thisStr(2), thisStr(3)
   RTBox1.SelColor = oldcolor
 End If
Case "quit" '退出
         RTBox1.SelStart = Len(RTBox1.Text)
    oldcolor = RTBox1.SelColor
    Select Case thisStr(3)
     Case "男生"
     RTBox1.SelColor = &HFF0000
     Case "女生"
     RTBox1.SelColor = &HFF
     Case Else
     RTBox1.SelColor = &H50B000
   End Select
   RTBox1.SelText = thisStr(2) + " "
   RTBox1.SelStart = Len(RTBox1.Text)
   RTBox1.SelColor = 3
   RTBox1.SelText = "离开了聊天室，对大家说“再见~！我还会再来的~~~！" + vbCrLf
   For i = 1 To UserList.ListItems.Count
    If UserList.ListItems(i).SubItems(1) = thisStr(2) Then
     UserList.ListItems.Remove i
     Exit Sub
    End If
   Next i
   RTBox1.SelColor = oldcolor
Case "change" '改名
End Select

End Sub

Private Sub Label4_Click()
RTBox1.Text = ""
End Sub

Private Sub Label8_Click()
Unload Me
End Sub

Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Data.GetFormat(vbCFText) Then
Text1.Text = Data.GetData(vbCFText)
End If

End Sub

Private Sub UserList_ItemClick(ByVal Item As MSComctlLib.ListItem)
cmbSelectUser.Text = Item.SubItems(1)
Text1.SetFocus

End Sub