toutes les couleur mirc et et exemple de smiley a vous d'en rajouter a votre guise
:)
a mettre dans un module
et a appeller
addmsg(nom de la form ou se trouve a richtextbox , le texte a afficher , le pseudo de la personne qui a envoiye le message)
voir capture
je posterais bientot le script entier
Source / Exemple :
Imports System.Drawing.Color
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Runtime.InteropServices
Imports System
Imports System.Threading
Module couleur
Const WM_VSCROLL As Integer = &H115
Const SB_BOTTOM As Integer = 7
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageW" (ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
Public Function addmsg(ByVal salon As String, ByVal msg23 As String, Optional ByVal nickmessage As String = "") As Boolean
Dim gras As Boolean = False
Dim Couleur As String = "1"
Dim CouleurArr As String = "0"
Dim MyChar As String
Dim MyChar2 As String
Dim Co As String = ""
Dim cntrl As Control
Dim Rich As RichTextBox = Nothing
Dim N_Form As Form
Dim souligne As Boolean = False
Dim arr As Boolean = False
Dim carr As String = "0"
For Each N_Form In Principale.MdiChildren
If N_Form.Name = salon Then
For Each cntrl In N_Form.Controls
If TypeOf cntrl Is RichTextBox Then
Rich = cntrl
Exit For
End If
Next
End If
Next
Try
If nickmessage <> "" Then
With Rich
.SelectionStart = Len(Rich.Text)
.SelectionProtected = False
.SelectionStart = Len(Rich.Text) + 1
.SelectionBackColor = White
.SelectionColor = coul(Couleur)
.SelectedText = vbNewLine & TimeOfDay & " : << " & nickmessage & " >> "
.SelectionProtected = True
End With
Else
With Rich
.SelectionStart = Len(Rich.Text)
.SelectionProtected = False
.SelectionStart = Len(Rich.Text) + 1
.SelectionColor = coul(Couleur)
.SelectionBackColor = White
.SelectedText = vbNewLine & TimeOfDay
.SelectionProtected = True
End With
End If
'les smiley
Dim longueur As Integer = Len(msg23)
For X As Integer = 1 To longueur
Dim debug As Integer = X
MyChar2 = Mid(msg23, X, 2)
Select Case MyChar2
Case ":|"
Clipboard.SetDataObject(New Bitmap(Application.StartupPath & "\Smiley\blaze.png"))
Rich.SelectionProtected = False
Rich.SelectionStart = Len(Rich.Text) - 1
Rich.SelectedText = ""
Rich.Paste()
Rich.SelectionProtected = True
Dim ms1 As String = Mid(msg23, 1, X - 1)
Dim ms2 As String = Mid(msg23, X + 2, Len(msg23))
msg23 = ms1 & ms2
Case ":)"
Clipboard.SetDataObject(New Bitmap(Application.StartupPath & "\Smiley\heureux.jpg"))
Rich.SelectionProtected = False
Rich.SelectionStart = Len(Rich.Text) - 1
Rich.SelectedText = ""
Rich.Paste()
Rich.SelectionProtected = True
Dim ms1 As String = Mid(msg23, 1, X - 1)
Dim ms2 As String = Mid(msg23, X + 2, Len(msg23))
msg23 = ms1 & ms2
Case LCase("? ")
Clipboard.SetDataObject(New Bitmap(Application.StartupPath & "\Smiley\ question.gif()"))
Rich.SelectionProtected = False
Rich.SelectionStart = Len(Rich.Text) - 1
Rich.SelectedText = ""
Rich.Paste()
Rich.SelectionProtected = True
Dim ms1 As String = Mid(msg23, 1, X - 1)
Dim ms2 As String = Mid(msg23, X + 2, Len(msg23))
msg23 = ms1 & ms2
End Select
'traiment de chaque caractere
MyChar = Mid(msg23, X, 1)
Select Case MyChar
Case Chr(3)
Do While IsNumeric(Mid(msg23, X, 1)) Or Mid(msg23, X, 1) = "," Or Mid(msg23, X, 1) = Chr(3)
Co = Co & Mid(msg23, X, 1)
X = X + 1
Loop
Couleur = Replace(Co, Chr(3), "")
If InStr(Couleur, ",") <> 0 Then
CouleurArr = Mid(Couleur, InStr(Couleur, ",") + 1, Len(Couleur))
Couleur = Mid(Couleur, 1, InStr(Couleur, ",", CompareMethod.Text) - 1)
End If
If Len(Couleur) > 2 Then
Couleur = Mid(Couleur, 1, 2)
X = X - 1
End If
If Len(CouleurArr) > 2 Then
CouleurArr = Mid(CouleurArr, 1, 2)
X = X - 1
End If
X = X - 1
Co = ""
Case Chr(2)
gras = IIf(gras = False, True, False)
Case Else
If MyChar = Chr(1) Or MyChar = Chr(15) Or MyChar = Chr(31) Or MyChar = Chr(3) Or MyChar = Chr(2) Then MyChar = ""
If Couleur = "" Then Couleur = "1"
If CType(Couleur, Integer) > 15 Then Couleur = "1"
If CouleurArr = "" Then CouleurArr = "0"
If CType(CouleurArr, Integer) > 15 Then CouleurArr = "0"
If gras = True Then
Dim bfont As New Font(Rich.Font, FontStyle.Bold)
With Rich
.SelectionProtected = False
.SelectionFont = bfont
.SelectionStart = Len(Rich.Text) + 1
.SelectionBackColor = coul(CouleurArr)
.SelectionColor = coul(Couleur)
.SelectedText = MyChar
.SelectionProtected = True
End With
Else
Dim bfont As New Font(Rich.Font, FontStyle.Regular)
With Rich
.SelectionProtected = False
.SelectionFont = bfont
.SelectionStart = Len(Rich.Text) + 1
.SelectionBackColor = coul(CouleurArr)
.SelectionColor = coul(Couleur)
.SelectedText = MyChar
.SelectionProtected = True
End With
End If
End Select
Next
Dim Tfont As New Font(Rich.Font, FontStyle.Regular)
With Rich
.SelectionProtected = False
.SelectionFont = Tfont
.SelectionStart = Len(Rich.Text) + 1
.SelectionBackColor = coul("0")
.SelectionColor = coul("1")
.SelectedText = ""
.SelectionProtected = True
End With
SendMessage(Rich.Handle, WM_VSCROLL, SB_BOTTOM, 0)
Catch ex As Exception
Dim sfont As New Font(Rich.Font, FontStyle.Regular)
With Rich
.SelectionProtected = False
.SelectionFont = sfont
.SelectionStart = Len(Rich.Text) + 1
.SelectionBackColor = coul("0")
.SelectionColor = coul("1")
.SelectedText = ""
.SelectionProtected = True
End With
SendMessage(Rich.Handle, WM_VSCROLL, SB_BOTTOM, 0)
End Try
End Function
Private Function coul(ByVal num As Integer) As Color
Select Case num
Case 0 : coul = Color.FromArgb(255, 255, 255)
Case 1 : coul = Color.FromArgb(0, 0, 0)
Case 2 : coul = Color.FromArgb(0, 0, 127)
Case 3 : coul = Color.FromArgb(0, 127, 0)
Case 4 : coul = Color.FromArgb(255, 0, 0)
Case 5 : coul = Color.FromArgb(127, 0, 0)
Case 6 : coul = Color.FromArgb(127, 0, 127)
Case 7 : coul = Color.FromArgb(255, 127, 0)
Case 8 : coul = Color.FromArgb(255, 255, 0)
Case 9 : coul = Color.FromArgb(0, 255, 0)
Case 10 : coul = Color.FromArgb(63, 127, 127)
Case 11 : coul = Color.FromArgb(0, 255, 255)
Case 12 : coul = Color.FromArgb(0, 0, 255)
Case 13 : coul = Color.FromArgb(255, 0, 255)
Case 14 : coul = Color.FromArgb(127, 127, 127)
Case 15 : coul = Color.FromArgb(191, 191, 191)
Case Else : coul = Color.FromArgb(0, 0, 0)
End Select
End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.