📄 client.frm
字号:
imgFriend(k).ToolTipText = arrFriends(k).nickname
lblName(k).Top = imgFriend(k).Top + imgFriend(k).Height + 50
lblName(k).Caption = arrFriends(k).nickname
Else
k = FriendCount - 1
Load imgFriend(k)
Load lblName(k)
imgFriend(k).Top = imgFriend(k - 1).Top + imgFriend(k - 1).Height + lblName(k - 1).Height + 250
lblName(k).Top = imgFriend(k).Top + imgFriend(k).Height + 50
Set imgFriend(k).Picture = ImageList.ListImages(arrFriends(k).img * 2 - arrFriends(k).state).Picture
imgFriend(k).ToolTipText = arrFriends(k).nickname
lblName(k).Caption = arrFriends(k).nickname
imgFriend(k).Visible = True
lblName(k).Visible = True
End If
'设置滚动条
HScroll.Value = 1
HScroll_Change
HScroll.Min = 1
HScroll.Max = lblName(k).Top + lblName(k).Height + 100
If HScroll.Max > picFriend.ScaleHeight Then
HScroll.Max = HScroll.Max - (picFriend.Height - HScroll.Height)
HScroll.Visible = True
HScroll.SmallChange = HScroll.Max / k
HScroll.LargeChange = HScroll.Max / k * 2
HScroll.Value = 1
HScroll_Change
Else
HScroll.Visible = False
End If
Exit Sub
Case "QICQFRD"
'填写好友数组
vardata = Right(vardata, Len(vardata) - 7)
Do While InStr(1, vardata, "QICQFRD", vbTextCompare) > 0
k = InStr(1, vardata, "QICQFRD", vbTextCompare)
strsub = Left(vardata, k - 1)
vardata = Right(vardata, Len(vardata) - k - 6)
'对strsub分析
location = 0
Do While location < 5
k = InStr(1, strsub, ",", vbTextCompare)
strsub1 = Left(strsub, k - 1)
strsub = Right(strsub, Len(strsub) - k)
location = location + 1
Select Case location
Case 1
arrFriends(FriendCount).username = strsub1
Case 2
arrFriends(FriendCount).nickname = strsub1
Case 3
arrFriends(FriendCount).img = Int(strsub1)
Case 4
arrFriends(FriendCount).state = Int(strsub1)
Case 5
arrFriends(FriendCount).ip = strsub1
End Select
Loop
FriendCount = FriendCount + 1
ReDim Preserve arrFriends(UBound(arrFriends) + 1)
Loop
'图像显示
'MsgBox CStr(FriendCount)
k = 0
imgFriend(k).Top = 100
Set imgFriend(k).Picture = ImageList.ListImages(arrFriends(k).img * 2 - arrFriends(k).state).Picture
imgFriend(k).ToolTipText = arrFriends(k).nickname
lblName(k).Top = imgFriend(k).Top + imgFriend(k).Height + 50
lblName(k).Caption = arrFriends(k).nickname
For k = 1 To FriendCount - 1
Load imgFriend(k)
Load lblName(k)
imgFriend(k).Top = imgFriend(k - 1).Top + imgFriend(k - 1).Height + lblName(k - 1).Height + 250
lblName(k).Top = imgFriend(k).Top + imgFriend(k).Height + 50
Set imgFriend(k).Picture = ImageList.ListImages(arrFriends(k).img * 2 - arrFriends(k).state).Picture
imgFriend(k).ToolTipText = arrFriends(k).nickname
lblName(k).Caption = arrFriends(k).nickname
imgFriend(k).Visible = True
lblName(k).Visible = True
Next
'设置滚动条
k = k - 1
HScroll.Min = 1
HScroll.Max = lblName(k).Top + lblName(k).Height + 100
If HScroll.Max > picFriend.ScaleHeight Then
HScroll.Max = HScroll.Max - (picFriend.Height - HScroll.Height)
HscrollValueBak = 1
HScroll.Visible = True
HScroll.SmallChange = HScroll.Max / k
HScroll.LargeChange = HScroll.Max / k * 2
HScroll.Value = 1
HScroll_Change
Else
HScroll.Visible = False
End If
'Exit Sub
Case "QICQRTC"
'二人世界申请
vardata = Right(vardata, Len(vardata) - 7)
Do While location < 6
k = InStr(1, vardata, ",", vbTextCompare)
strsub = Left(vardata, k - 1)
location = location + 1
vardata = Right(vardata, Len(vardata) - k)
Select Case location
Case 1
strName = strsub
Case 2
strip = strsub
Case 3
port = CLng(strsub)
Case 4
strNickName = strsub
Case 5
intImg = Int(strsub)
Case 6
intState = Int(strsub)
End Select
Loop
strQuery = vardata
If Len(vardata) <> 0 Then
strsub = "并发来信息：" + vardata
Else
strsub = ""
End If
'查找此用户是否是好友
For k = 0 To FriendCount - 1
If arrFriends(k).username = strName Then Exit For
Next
If k <= FriendCount - 1 Then
'是好友
If MsgBox(arrFriends(k).nickname + "要和你建立聊天二人世界，" + strsub, vbOKCancel + vbQuestion, "二人世界请求！") = vbOK Then
'建立二人世界，新建窗口frmtwo
Set frmNewTwo(TwoCount) = New frmTwo
frmNewTwo(TwoCount).Tag = strName
frmNewTwo(TwoCount).Show
frmNewTwo(TwoCount).wskUDP.RemoteHost = strip
frmNewTwo(TwoCount).wskUDP.RemotePort = port
'本地端口
frmNewTwo(TwoCount).wskUDP.LocalPort = 10000 + ConCount * 2 + 1
frmNewTwo(TwoCount).ImgFrd = LoadPicture(App.Path + "\ico\" + CStr(intImg) + ".ico")
frmNewTwo(TwoCount).lblFrd = strNickName
'填写连接信息
arrCon(ConCount).ip = strip
arrCon(ConCount).port = port
arrCon(coucount).username = strName
'发送信息给对方
frmClient.wskClient.SendData "QICQATC" + CStr(10000 + ConCount * 2 + 1) + "," + strName
'数组扩展
ConCount = ConCount + 1
ReDim Preserve arrCon(UBound(arrCon) + 1)
TwoCount = TwoCount + 1
ReDim Preserve frmNewTwo(UBound(frmNewTwo) + 1)
Else
'拒绝
frmClient.wskClient.SendData "QICQATC-1," + strName
End If
Else
'不是好友
MsgBox arrFriends(k).nickname + "要和你建立聊天二人世界，" + strsub + ",但他（她）不是你的好友，是否添加他（她）为好友，并建立聊天二人世界？"
MsgBox "此代码请读者完成！"
End If
Exit Sub
Case "QICQATC"
'二人世界连接
vardata = Right(vardata, Len(vardata) - 7)
k = InStr(1, vardata, ",", vbTextCompare)
'建立连接
strName = Left(vardata, k - 1)
port = CLng(Right(vardata, Len(vardata) - k))
If port <> -1 Then
For k = 0 To FriendCount - 1
If arrFriends(k).username = strName Then Exit For
Next
Set frmNewTwo(TwoCount) = New frmTwo
frmNewTwo(TwoCount).Tag = strName
frmNewTwo(TwoCount).Show
frmNewTwo(TwoCount).wskUDP.RemoteHost = arrFriends(k).ip
frmNewTwo(TwoCount).wskUDP.RemotePort = port
'本地端口
frmNewTwo(TwoCount).wskUDP.LocalPort = 10000 + ConCount * 2
frmNewTwo(TwoCount).ImgFrd = LoadPicture(App.Path + "\ico\" + CStr(arrFriends(k).img) + ".ico")
frmNewTwo(TwoCount).lblFrd = arrFriends(k).nickname
'填写连接信息
arrCon(ConCount).ip = arrFriends(k).ip
arrCon(ConCount).port = port
arrCon(coucount).username = arrFriends(k).username
'数组扩展
ConCount = ConCount + 1
ReDim Preserve arrCon(UBound(arrCon) + 1)
TwoCount = TwoCount + 1
ReDim Preserve frmNewTwo(UBound(frmNewTwo) + 1)
Else
MsgBox "用户拒绝请求！", vbInformation
End If
Unload frmConTwo
Exit Sub
Case "QICQUPL"
'好友在线信息
vardata = Right(vardata, Len(vardata) - 7)
k = InStr(1, vardata, ",", vbTextCompare)
strName = Left(vardata, k - 1)
strip = Right(vardata, Len(vardata) - k)
For k = 0 To FriendCount - 1
If arrFriends(k).username = strName Then Exit For
Next
'更改
arrFriends(k).ip = strip
arrFriends(k).state = 1
imgFriend(k).Picture = ImageList.ListImages(arrFriends(k).img * 2 - 1).Picture
Exit Sub
Case "QICQOUT"
'离线
strName = Right(vardata, Len(vardata) - 7)
For k = 0 To FriendCount - 1
If arrFriends(k).username = strName Then Exit For
Next
arrFriends(k).state = 1
imgFriend(k).Picture = ImageList.ListImages(arrFriends(k).img * 2).Picture
'退出对话
For k = 0 To TwoCount - 1
If frmNewTwo(k).Tag = strName Then
Unload frmNewTwo(k)
Exit For
End If
Next
Exit Sub
End Select
If Left(vardata, 7) = "QICQSTA" Then
vardata = Right(vardata, Len(vardata) - 7)
Select Case vardata
Case "用户注册成功！"
cmdLogout.Enabled = True
cmdLogin.Enabled = False
cmdRegister.Enabled = False
cmdFind.Enabled = True
cmdInfo.Enabled = True
cmdChat.Enabled = True
' mnuLeft.Visible = True
'mnuRight.Visible = True
Unload frmReg
Unload frmLogin
Case "用户已经存在！"
Case "你成功登录了！"
Unload frmLogin
cmdLogin.Enabled = False
cmdLogout.Enabled = True
cmdRegister.Enabled = False
cmdFind.Enabled = True
cmdInfo.Enabled = True
cmdChat.Enabled = True
'mnuLeft.Visible = True
'mnuRight.Visible = True
Case "没有这个用户！"
'重新登录
cmdLogout.Enabled = False
cmdRegister.Enabled = False
cmdLogin.Enabled = True
Case "系统关闭！"
MsgBox vardata
cmdLogout.Enabled = False
cmdRegister.Enabled = False
cmdLogin.Enabled = True
If FriendCount > 0 Then
For k = 1 To FriendCount - 1
Unload imgFriend(k)
Unload lblName(k)
Next
Set imgFriend(0).Picture = Nothing
lblName(0).Caption = ""
ReDim arrFriends(1) As FriendInfo
FriendCount = 0
End If
For k = 0 To TwoCount - 1
Unload frmNewTwo(k)
Next
TwoCount = 0
ReDim frmNewTwo(1) As frmTwo
' Unload Me
Exit Sub
End Select
MsgBox vardata
End If
End Sub
Private Sub wskClient_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox Description, vbInformation, "出错"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -