如何实现像QQ聊天表情的发送？

[yefeng835]

我在用VB6做一个局域网聊天室，显示聊天内容是RichText控件，已经实现了不同颜色的显示和自定义颜色显示。但如果实现像QQ一样的表情显示呢？
有人说用表情定义符，在内容中如果有类似“/aiq”字样时，就转换插入本地已存的表情，但是这种方法，如何能使RichText接收到内容时自动转换呢？或者有哪些有这种功能的控件？
谢谢大家的热心帮助！

[zzyong00]

QQ也不完全是表情符号代码图片，有的自定义的图片可以用

[yefeng835]

本地的图片插入我会，如果一个信息内容里只有一个图片，没有其它字符的话，就很好实现。但是，如果信息内容里有字符又有图片转义符，是不是要用到查找的方式，只要是碰到了类似的匹配字符，就转换，是这样吗？

[letusgo1234567890]

查找分析是必须的，要不替换也可以。。。你自己做可以给出一种特点的唯一格式来实现

[yefeng835]

我试过一种方式，代码如下：

Private Sub Face_Text(ByVal Text As String) '过程,变量Text接收传送过来的字符串，代表着用户所发送的信息内容
'表情
Dim a As Integer
Dim str1 As String
Dim g As New GifAnimator

a = InStr(1, Text, "/")
'我是以“/01”或“/02..../75”来定义不同的图片的

str1 = Mid(Text, a + 1, 2)

If IsNumeric(str1) Then

Select Case str1
Case "01":
fi = App.Path & "\Face\01.gif"
Case "02":
fi = App.Path & "\Face\02.gif"
Case "03":
fi = App.Path & "\Face\03.gif"
Case "04":
fi = App.Path & "\Face\04.gif"
Case "05":
fi = App.Path & "\Face\05.gif"
Case "06":
fi = App.Path & "\Face\06.gif"
Case "07":
fi = App.Path & "\Face\07.gif"
Case "08":
fi = App.Path & "\Face\08.gif"
Case "09":
fi = App.Path & "\Face\09.gif"
Case "10":
fi = App.Path & "\Face\10.gif"
Case "11":
fi = App.Path & "\Face\11.gif"
Case "12":
fi = App.Path & "\Face\12.gif"
Case "13":
fi = App.Path & "\Face\13.gif"
Case "14":
fi = App.Path & "\Face\14.gif"
Case "15":
fi = App.Path & "\Face\15.gif"
Case "16":
fi = App.Path & "\Face\16.gif"
Case "17":
fi = App.Path & "\Face\17.gif"
Case "18":
fi = App.Path & "\Face\18.gif"
Case "19":
fi = App.Path & "\Face\19.gif"
Case "20":
fi = App.Path & "\Face\20.gif"
Case "21":
fi = App.Path & "\Face\21.gif"
Case "22":
fi = App.Path & "\Face\22.gif"
Case "23":
fi = App.Path & "\Face\23.gif"
Case "24":
fi = App.Path & "\Face\24.gif"
Case "25":
fi = App.Path & "\Face\25.gif"
Case "26":
fi = App.Path & "\Face\26.gif"
Case "27":
fi = App.Path & "\Face\27.gif"
Case "28":
fi = App.Path & "\Face\28.gif"
Case "29":
fi = App.Path & "\Face\29.gif"
Case "30":
fi = App.Path & "\Face\30.gif"
Case "31":
fi = App.Path & "\Face\31.gif"
Case "32":
fi = App.Path & "\Face\32.gif"
Case "33":
fi = App.Path & "\Face\33.gif"
Case "34":
fi = App.Path & "\Face\34.gif"
Case "35":
fi = App.Path & "\Face\35.gif"
Case "36":
fi = App.Path & "\Face\36.gif"
Case "37":
fi = App.Path & "\Face\37.gif"
Case "38":
fi = App.Path & "\Face\38.gif"
Case "39":
fi = App.Path & "\Face\39.gif"
Case "40":
fi = App.Path & "\Face\40.gif"
Case "41":
fi = App.Path & "\Face\41.gif"
Case "42":
fi = App.Path & "\Face\42.gif"
Case "43":
fi = App.Path & "\Face\43.gif"
Case "44":
fi = App.Path & "\Face\44.gif"
Case "45":
fi = App.Path & "\Face\45.gif"
Case "46":
fi = App.Path & "\Face\46.gif"
Case "47":
fi = App.Path & "\Face\47.gif"
Case "48":
fi = App.Path & "\Face\48.gif"
Case "49":
fi = App.Path & "\Face\49.gif"
Case "50":
fi = App.Path & "\Face\50.gif"
Case "51":
fi = App.Path & "\Face\51.gif"
Case "52":
fi = App.Path & "\Face\52.gif"
Case "53":
fi = App.Path & "\Face\53.gif"
Case "54":
fi = App.Path & "\Face\54.gif"
Case "55":
fi = App.Path & "\Face\55.gif"
Case "56":
fi = App.Path & "\Face\56.gif"
Case "57":
fi = App.Path & "\Face\57.gif"
Case "58":
fi = App.Path & "\Face\58.gif"
Case "59":
fi = App.Path & "\Face\59.gif"
Case "60":
fi = App.Path & "\Face\60.gif"
Case "61":
fi = App.Path & "\Face\61.gif"
Case "62":
fi = App.Path & "\Face\62.gif"
Case "63":
fi = App.Path & "\Face\63.gif"
Case "64":
fi = App.Path & "\Face\64.gif"
Case "65":
fi = App.Path & "\Face\65.gif"
Case "66":
fi = App.Path & "\Face\66.gif"
Case "67":
fi = App.Path & "\Face\67.gif"
Case "68":
fi = App.Path & "\Face\68.gif"
Case "69":
fi = App.Path & "\Face\69.gif"
Case "70":
fi = App.Path & "\Face\70.gif"
Case "71":
fi = App.Path & "\Face\71.gif"
Case "72":
fi = App.Path & "\Face\72.gif"
Case "73":
fi = App.Path & "\Face\73.gif"
Case "74":
fi = App.Path & "\Face\74.gif"
Case "75":
fi = App.Path & "\Face\75.gif"

End Select

g.LoadFromFile fi

Text = Replace(Text, "/" & str1, "") 'str1为替换内容,""为被替换的内容
AddClass Text2.hwnd, g '一个插入GIF动态图片的模块，Text2是控件名，显示信息内容用的

Else

End If

End Sub

但这种有个问题，每次发送的信息只能包含一种表情，而且/02这些转义的符号去不掉，表情插到了用户所发送的内容最后。
怎么解决呢？

[tzwsoho]

汗....代码不需要那么长吧...直接连接下字符串就可以了///

fi=app.path & "\face\" & str1 & ".gif"

[-晴天]

用replace函数.

[UltraBejing]

关注 接分

[knowledge_Is_Life]

不会,帮顶

[jowzey_liu]

同上

[VirtualDesktop]

你用这种替换的方法插入在vb6下面的RichTextBox是不太可行的，因为vb6那个RichTextBox功能实在太弱了

我以前采用的思路是这样,查找表情符的代号，选中它(用SelStart,SelLength)，然后用SendMessage的方式插入到选中区
具体代码你可以看看我写的ZX Messenger www.skycn.com/soft/13653.html ,如果你有耐心的话...

[spotty2008]

同上

[goodluck16]

关注

[anfly]

我想，它所有的表情符是不是都是用一种格式来写的，比如都用:号来开头，那就好办了，用SPLIT对字符串做一个分析就好了
，如果发现有那就再对应出现表情。我想大家也知道在QQ里面不是一定要点表情才出的，你输入一个:p还是什么来着就会有的。
对不对：）新手一点想法，见笑了。

[违规用户已删除]

有没有想过用正则表达式呢,
把它提出来,然后再换.
比你直接换要强,
RegExp

[fvflove]

为什么不可以每次输入一个字符都与前面的几个字符相配。如果是自定义的图片符号就替换不可以蚂？

[aspd199]

这个我做过，但是richtextbox在判断字符长度时存在问题，如果是全英文输入，多少个图片也没问题，但如果是中文输入，就会导致图片的错位显示

[fvflove]

判断的时候用 midB 或 LEFTB之类的不行吗?

[ditze]

听说 回帖是一种美德！传说每天回帖即可获得 10 分可用分！
新人来学习的来了

[n_yHHy_n]

听说 回帖是一种美德！传说每天回帖即可获得 10 分可用分！
新人来学习的来了

[aamiiLA]

这个可以用查找转换呀。用一个查找颜色等属性的程序来代替：
Private Sub RichTextBox1_Change()
Dim StartPosition As Integer
Dim Startcolor As Integer
Dim p1 As Integer
Dim n As Integer

With RichTextBox1
'换之前先提取当前的光标位置
StartPosition = .SelStart
Startcolor = &H0&

'然后循环找函数并换
n = 1
RichTextBox2.TextRTF = RichTextBox1.Text
Do
p1 = InStr(n, RichTextBox1.Text, "01.gif")
Select Case p1
Case 0
Exit Do
Case Is <> 0
.SelStart = p1
.SelLength = Len("01.gif")
call imss'如果有符合的就插入图片
n = p1 + Len("01.gif")
End Select
Loop
'换完后再把当前的光标位置恢复
.SelStart = StartPosition
.SelLength = 0
.SelColor = Startcolor
End With
End Sub