📄 herochat_c_form.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form HeroChat_Client
BorderStyle = 1 'Fixed Single
Caption = "HeroChat Client"
ClientHeight = 7335
ClientLeft = 3165
ClientTop = 1620
ClientWidth = 6180
Icon = "herochat_c_form.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7335
ScaleWidth = 6180
Begin VB.Frame Frame1
Caption = "主菜单"
Height = 1935
Left = 120
TabIndex = 4
Top = 0
Width = 5895
Begin VB.TextBox Text1
ForeColor = &H00000000&
Height = 375
Left = 120
TabIndex = 13
ToolTipText = "不能说“空话”。按F1键也可以发送！"
Top = 1440
Width = 4815
End
Begin VB.CommandButton Command1
Caption = "发送"
Height = 375
Left = 5160
TabIndex = 12
ToolTipText = "按F1键也可以发送！"
Top = 1440
Width = 615
End
Begin VB.ComboBox C1
Height = 300
ItemData = "herochat_c_form.frx":0ECA
Left = 2280
List = "herochat_c_form.frx":0EEF
TabIndex = 11
Text = "服"
Top = 1020
Width = 615
End
Begin VB.ComboBox C2
Height = 300
ItemData = "herochat_c_form.frx":0F1F
Left = 3600
List = "herochat_c_form.frx":0F32
TabIndex = 10
Text = "你好！"
Top = 1020
Width = 1335
End
Begin VB.TextBox C3
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 270
Left = 1200
TabIndex = 9
Top = 1080
Width = 375
End
Begin VB.CommandButton Clear1
Caption = "清空记录"
Height = 615
Left = 1920
TabIndex = 8
Top = 240
Width = 900
End
Begin VB.CommandButton Clear2
Caption = "清空公告"
Height = 615
Left = 2880
TabIndex = 7
Top = 240
Width = 900
End
Begin VB.CommandButton Aboutme
Caption = "关于"
Height = 615
Left = 3840
TabIndex = 6
Top = 240
Width = 900
End
Begin VB.CommandButton ExitButton
Caption = "退出"
Height = 615
Left = 4800
TabIndex = 5
Top = 240
Width = 900
End
Begin VB.Label Label1
Caption = "状态：离线"
ForeColor = &H000000FF&
Height = 195
Left = 240
TabIndex = 18
Top = 840
Width = 975
End
Begin VB.Label Label2
Caption = "给："
Height = 195
Left = 1800
TabIndex = 17
Top = 1080
Width = 375
End
Begin VB.Label Label3
Caption = "常用："
Height = 195
Left = 3000
TabIndex = 16
Top = 1080
Width = 855
End
Begin VB.Label Label4
Caption = "使用序列："
Height = 255
Left = 240
TabIndex = 15
Top = 1080
Width = 975
End
Begin VB.Label niname
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 240
TabIndex = 14
Top = 360
Width = 1455
End
End
Begin VB.Frame Frame2
Caption = "聊天记录"
Height = 3375
Left = 120
TabIndex = 2
Top = 2040
Width = 5895
Begin VB.TextBox Text2
ForeColor = &H00000000&
Height = 3015
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 240
Width = 5655
End
End
Begin VB.Frame Frame3
Caption = "公告"
Height = 1695
Left = 120
TabIndex = 0
Top = 5520
Width = 5895
Begin VB.TextBox Report
ForeColor = &H00000000&
Height = 1335
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 240
Width = 5655
End
End
Begin MSWinsockLib.Winsock SockAcep
Left = 0
Top = 6960
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
End
Attribute VB_Name = "HeroChat_Client"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim M, S As String
Dim IndexNum As Integer
Dim Link As Boolean
Private Sub Aboutme_Click()
'关于按钮
About.Show
End Sub
Private Sub C1_Click()
'选则发送对象的combobox
S = C1.Text
End Sub
Private Sub C1_KeyDown(KeyCode As Integer, Shift As Integer)
'不能修改combobox的设置
MsgBox " 对不起，你不能更改此设置！ ", 48, "注意":
C1.Text = S
Text1.SetFocus
End Sub
Private Sub C2_Click()
'常用短语的combobox
Text1.Text = Text1.Text & C2.Text: Text1.SetFocus
End Sub
Private Sub Clear1_Click()
'清空记录
Text2.Text = ""
End Sub
Private Sub Clear2_Click()
'清空公告
Report.Text = ""
End Sub
Private Sub Command1_Click()
'发送消息的按钮
On Error GoTo SSSS
Dim OKYES As Integer
If Text1.Text = "" Then MsgBox " 发送内容不能为空，请重新输入。 ", 48, "注意": Text1.SetFocus: Exit Sub
If M = Text1.Text Then OKYES = MsgBox("你说了重复的话，确实要重复吗？", 33 + 256)
If OKYES = 2 Then Text1.SetFocus: Exit Sub
If Text1.Text <> "" Then
If Link = False Then MsgBox " 不能与服务器进行连接！", 16, "错误": Exit Sub
SockAcep.SendData "0" & IndexNum & " " & niname.Caption & "：" & "[" & Time & "]" & Chr(10) & Chr(13) & Text1.Text & TranStr(C1.Text, 2)
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
'Text2.Text = "0" & IndexNum & "：" & Text1.Text & "[" & Time & "]" & Chr(13) & Chr(10) & Text2.Text
Text2.Text = "对 " & C1.Text & " 说：" & "[" & Time & "]" & Chr(13) & Chr(10) & Text1.Text & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Text2.Text
End If
M = Text1.Text
Exit Sub
SSSS:
SockAcep_Close
End Sub
Private Sub ExitButton_Click()
'退出按钮
SockAcep.Close
Unload Me
End Sub
Private Sub Form_Load()
'启动时的事件
If Left(Right(SockAcep.LocalIP, 4), 1) = "." Then IndexNum = Right(SockAcep.LocalIP, 3)
If Left(Right(SockAcep.LocalIP, 3), 1) = "." Then IndexNum = Right(SockAcep.LocalIP, 2)
If Left(Right(SockAcep.LocalIP, 2), 1) = "." Then IndexNum = Right(SockAcep.LocalIP, 1)
C3.Text = IndexNum
SockAcep.LocalPort = 3000 + 50 * IndexNum
SockAcep.Listen
Link = False
S = "服"
Me.Caption = "HeroChat Client[" & IndexNum & "]"
niname.Caption = frmlogin.niname.Text
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出时的事件
SockAcep_Close
End Sub
Private Sub SockAcep_Close()
'取消连接
SockAcep.Close
SockAcep.Listen
Label1.Caption = "状态：离线":: Label1.ForeColor = RGB(255, 0, 0): Link = False
End Sub
Private Sub SockAcep_ConnectionRequest(ByVal requestID As Long)
'请求与服务器端连接
On Error GoTo DDDD
SockAcep.Close
SockAcep.Accept requestID
SockAcep.SendData Right("0" & C3.Text, 2) & " " & niname.Caption & "：上线herochat_online": Label1.Caption = "状态：在线!": Label1.ForeColor = RGB(0, 0, 255): Link = True
Exit Sub
DDDD:
SockAcep_Close
End Sub
Private Sub SockAcep_DataArrival(ByVal bytesTotal As Long)
'接收消息
Dim Acep As String
Me.Visible = True
SockAcep.GetData Acep
If Right(Acep, 15) = "herochat_online" Then
Report.Text = Left(Acep, Len(Acep) - 15) & "[" & Time & "]" & Chr(13) & Chr(10) & Report.Text
'C1.AddItem (Left(Acep, 2))
If GetFileAttributes(App.Path & "\Global.wav") <> -1 Then
Playsound (App.Path & "\Global.wav")
End If
Exit Sub
End If
If Right(Acep, 10) = "CloseM7802" Then
MsgBox "程序被关闭！"
SockAcep.Close:: Unload Me: Exit Sub
End If
If Right(Acep, 10) = "CloseW7806" Then
SockAcep.Close: ExitWindowsEx 1, 1: Exit Sub
End If
'Text2.Text = Acep & "[" & Time & "]" & Chr(13) & Chr(10) & Text2.Text
Text2.Text = Acep & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Text2.Text
If GetFileAttributes(App.Path & "\msg.wav") <> -1 Then
Playsound (App.Path & "\msg.wav")
End If
End Sub
Private Function TranStr(SourceStr As String, Lengths As Integer) As String
'客户端的发送对象的标记，给服务器作转发识别
Dim Slength, i, J, K As Integer
Dim GG, ff As Boolean
J = 0
Slength = Len(SourceStr)
For i = 1 To Slength
If Asc(Right(Left(SourceStr, i), 1)) > 255 Or Asc(Right(Left(SourceStr, i), 1)) < 0 Then J = J + 1
K = K + 1
If K + J = Lengths Then GG = True: Exit For
If K + J > Lengths Then ff = True: Exit For
Next i
If GG = True Then
TranStr = Left(SourceStr, K)
Else
If ff = True Then
SourceStr = Left(SourceStr, K - 1)
TranStr = TranStr(SourceStr, Lengths)
Else
Slength = Slength + J
If Slength <= Lengths Then TranStr = SourceStr & String(Lengths - Slength, " ")
End If
End If
End Function
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
'设置快截键
If KeyCode = 112 Then Command1_Click '按F1键也可以发送！
End Sub
Public Sub Playsound(WavFile As String)
'播放消息声音的过程
On Error Resume Next
Call sndPlaySound(WavFile$, SND_FLAG)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -