Couleur mirc et smiley pour richtextbox vb.net 2005

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 255 fois - Téléchargée 31 fois

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

Ajouter un commentaire

Commentaires

yohan49
Messages postés
382
Date d'inscription
samedi 22 janvier 2005
Statut
Membre
Dernière intervention
13 août 2011
7 -
du fait que chaque caractere soit analyse un par un c meme mes style d'ecriture les plus complexe sont retranscrite a l'identique seul bug connue c quand un user utilise ce script ! : ?haMan script ! et remarque vu comment il a ete fait c pas etonnant ! lol

5 ctrl+K avant de mettre le numero de couleur , c du nawak lol
cs_sub-zero
Messages postés
98
Date d'inscription
mercredi 22 novembre 2000
Statut
Membre
Dernière intervention
12 juillet 2005
-
ya t'il une autre facon pour insérer des bitmap que de passer par le clipboard?
yohan49
Messages postés
382
Date d'inscription
samedi 22 janvier 2005
Statut
Membre
Dernière intervention
13 août 2011
7 -
si regarde dans les sources , j'ai vu un code pour inserrer une image sans le clipboard :)
jrbleboss
Messages postés
480
Date d'inscription
jeudi 6 mai 2004
Statut
Membre
Dernière intervention
3 septembre 2007
-
Sa a l'air j'ai le framework mais j'ai la fleme de regarder.

JRB
cs_liquide
Messages postés
1018
Date d'inscription
samedi 22 mars 2003
Statut
Membre
Dernière intervention
24 juin 2008
-
SUB-ZERO, va voir dans mes sources, sans le presse papier.

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.