Couleur mirc et smiley pour richtextbox vb.net 2005

Commenter

Contenu du snippet

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

A voir également

S'inscrire maintenant

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.

Du même auteur (yohan49)