Author: ? (unknown)
Difficulty: 2/5
WARNING: This took me four hours to do, and I suggest you make a backup of modText.bas.
USE AT YOUR OWN RISK! This is commented, so I don't think that I should get to bombarded with questions.
Alright, this will add emoticon support to your client, but if the users actually click on an emoticon, they will see that they can "play" with it a bit, that is the only draw back so far. I am trying to come up with a way to use HTML and the IE control for better support...
1. Open frmMirage in Visual mode
2. Add in a picture box, named picBuffer, and set .visible to FALSE
3. Add in a frame, named frmIcon, and set .visible to FALSE
4. On frmIcon, make an INDEXED image (as many as you want for emoticons), named imgIcon.
Okay, now go to modText, and find AddText, and Delete everything in there, and put this in.
Code:
Public Sub AddText(ByVal Msg As String, ByVal Color As Integer)
Dim s As String
Dim NewColor As Integer
Dim lImagePos As Long
Dim lStartMessage As Long
Dim i As Integer, iCC As Integer
Dim CharCombo() As String
Dim ClipboardContents As Variant
Dim bClipHasImage As Boolean
Dim checkForMessage As Integer
Dim chkChar As String
Dim KillNullChar As Integer
s = vbNewLine & Msg
NewColor = Color
bClipHasImage = Clipboard.GetFormat(vbCFBitmap) 'If there's an image in the clipboard
If bClipHasImage Then frmMirage.picBuffer.Picture = Clipboard.GetData 'Store it to picBuffer
frmMirage.txtChat.SelColor = QBColor(Color)
frmMirage.txtChat.Locked = False 'Must be unlocked for SendMessage() to work
frmMirage.txtChat.SelText = s
frmMirage.txtChat.SelStart = Len(frmMirage.txtChat.Text) - 1
lStartMessage = Len(s) - 1
frmMirage.txtChat.SelStart = Len(frmMirage.txtChat.Text) - 1
For i = 0 To frmMirage.imgIcon.Count - 1 'Loop through each icon
CharCombo = Split(frmMirage.imgIcon(i).Tag, " ") 'Get the valid character combinations
' which should be delimited by spaces
' in the .Tag property
For iCC = 0 To UBound(CharCombo) 'Loop through those character combos
lImagePos = InStr(lStartMessage, frmMirage.txtChat.Text, CharCombo(iCC))
While lImagePos > 0 'While the char combo is present
frmMirage.txtChat.SelStart = lImagePos - 1
frmMirage.txtChat.SelLength = Len(CharCombo(iCC)) 'Clear the char combo text
frmMirage.txtChat.SelText = ""
Clipboard.Clear 'Clear the clipboard (required)
Clipboard.SetData frmMirage.imgIcon(i).Picture 'Set the icon in it
SendMessage frmMirage.txtChat.hWnd, WM_PASTE, 0, 0 'Paste it to the frmMirage.txtChat
'Find any more of that same icon
lImagePos = InStr(lImagePos, frmMirage.txtChat.Text, CharCombo(iCC))
Wend
Next iCC
Next i
frmMirage.txtChat.Locked = True 'Lock the chat back up
If bClipHasImage Then
Clipboard.SetData frmMirage.picBuffer.Picture 'Put the old clipboard contents back
Else
Clipboard.Clear 'If there were none, then clear it. There's no use in leaving
End If ' an icon sitting in there
frmMirage.txtChat.SelStart = Len(frmMirage.txtChat.Text)
ResumeNormalOps:
frmMirage.txtChat.Locked = True
End Sub
Add the following to modDeclares:
Code:
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Add the following to modConstants:
Code:
Public Const WM_PASTE = &H302
Okay, now this is the catch. imgIcon MUST have BMPs, JPGs or GIFs in it, with there background colors done to the same color as your txtChat backcolor.
Login
Register
FAQ
Search
Members
