Accueil > > > MSN DÉGRADÉS DE COULEURS
MSN DÉGRADÉS DE COULEURS
Information sur la source
Description
On indique la phrase à colorer, ainsi que la couleur de départ et d'arrivée,
et le résultat est mit dans le presse papiers.
Il ne vous reste plus qu'à faire "coller" pendant une conversation.
Il sert pour les messages envoyés, et non pour changer le nom,
et pour voir les couleurs, il faut avoir MSN +.
Source
- Public Sub CRGB(ByVal Couleur As Long, Red As Long, Green As Long, Blue As Long)
-
- Blue = Int(Couleur / 65536)
- Green = Int((Couleur - (65536 * Blue)) / 256)
- Red = Couleur - ((Blue * 65536) + (Green * 256))
-
- End Sub
-
- Private Sub Form_Load()
- Dim texte As String
- texte = InputBox("Phrase ?", "Texte à colorer ?", "bonjour !")
- If Len(texte) > 68 Then
- MsgBox "Phrase trop longue (> 68 caractères).", vbCritical, "ERREUR"
- Unload Me
- Exit Sub
- End If
- Dim tableau() As String
- ReDim tableau(Len(texte) - 1) As String
- Dim num As Byte
- For num = 0 To UBound(tableau)
- tableau(num) = Mid(texte, num + 1, 1)
- Next
- Dim couleurs(5) As Long
- MsgBox "Veuillez selectionner la couleur de départ.", vbInformation, "Info"
- CDlg1.ShowColor
- MsgBox "Veuillez selectionner la couleur d'arrivée.", vbInformation, "Info"
- CRGB CDlg1.Color, couleurs(0), couleurs(1), couleurs(2)
- CDlg1.ShowColor
- CRGB CDlg1.Color, couleurs(3), couleurs(4), couleurs(5)
- Dim stat As Byte
- Dim rgb(2) As String
- Dim tres As String
- tres = ""
- Dim num2 As Byte
- For num = 0 To UBound(tableau)
- rgb(0) = CInt(((num / UBound(tableau)) * couleurs(3)) + ((1 - (num / UBound(tableau))) * couleurs(0)))
- rgb(1) = CInt(((num / UBound(tableau)) * couleurs(4)) + ((1 - (num / UBound(tableau))) * couleurs(1)))
- rgb(2) = CInt(((num / UBound(tableau)) * couleurs(5)) + ((1 - (num / UBound(tableau))) * couleurs(2)))
- For num2 = 0 To 2
- Do While Len(rgb(num2)) < 3
- rgb(num2) = "0" & rgb(num2)
- Loop
- Next
- tres = tres + "(" & rgb(0) & "," & rgb(1) & "," & rgb(2) & ")" & tableau(num)
- Next
- MsgBox "Résultat mit dans le presse papiers.", vbInformation, "Fin"
- Clipboard.Clear
- Clipboard.SetText tres
- Unload Me
- End Sub
Public Sub CRGB(ByVal Couleur As Long, Red As Long, Green As Long, Blue As Long)
Blue = Int(Couleur / 65536)
Green = Int((Couleur - (65536 * Blue)) / 256)
Red = Couleur - ((Blue * 65536) + (Green * 256))
End Sub
Private Sub Form_Load()
Dim texte As String
texte = InputBox("Phrase ?", "Texte à colorer ?", "bonjour !")
If Len(texte) > 68 Then
MsgBox "Phrase trop longue (> 68 caractères).", vbCritical, "ERREUR"
Unload Me
Exit Sub
End If
Dim tableau() As String
ReDim tableau(Len(texte) - 1) As String
Dim num As Byte
For num = 0 To UBound(tableau)
tableau(num) = Mid(texte, num + 1, 1)
Next
Dim couleurs(5) As Long
MsgBox "Veuillez selectionner la couleur de départ.", vbInformation, "Info"
CDlg1.ShowColor
MsgBox "Veuillez selectionner la couleur d'arrivée.", vbInformation, "Info"
CRGB CDlg1.Color, couleurs(0), couleurs(1), couleurs(2)
CDlg1.ShowColor
CRGB CDlg1.Color, couleurs(3), couleurs(4), couleurs(5)
Dim stat As Byte
Dim rgb(2) As String
Dim tres As String
tres = ""
Dim num2 As Byte
For num = 0 To UBound(tableau)
rgb(0) = CInt(((num / UBound(tableau)) * couleurs(3)) + ((1 - (num / UBound(tableau))) * couleurs(0)))
rgb(1) = CInt(((num / UBound(tableau)) * couleurs(4)) + ((1 - (num / UBound(tableau))) * couleurs(1)))
rgb(2) = CInt(((num / UBound(tableau)) * couleurs(5)) + ((1 - (num / UBound(tableau))) * couleurs(2)))
For num2 = 0 To 2
Do While Len(rgb(num2)) < 3
rgb(num2) = "0" & rgb(num2)
Loop
Next
tres = tres + "(" & rgb(0) & "," & rgb(1) & "," & rgb(2) & ")" & tableau(num)
Next
MsgBox "Résultat mit dans le presse papiers.", vbInformation, "Fin"
Clipboard.Clear
Clipboard.SetText tres
Unload Me
End Sub
Historique
- 15 septembre 2006 15:49:41 :
- Modification de la description.
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
msn messenger [ par Badine ]
comment programmer une aplication chat internetc a dir le serveur est distant a l autre bout de la planetec a dir il passe a traver les fire wire j ai
Besoin d'aide pour un msn messnger en vb [ par Black Samourail ]
Salut toul monde je programme actuellement un lgiciel du genre msn messenger service et pour fair pro j'airepris l'interface de 'l archiecture orienté
MSN chat room [ par [vbtom] ]
Bonjour, SI quelqu'un pouvait m'expliquer comment les chat MSN marchent...C'est avec un control Active X mais c'est tout ce que je sais...SI quelqu
Le look à la MSN messenger / XP [ par lhalin ]
Salut à tous,Savez-vous comment créer des frame avec le look à la MSN MEssenger ou XP, avec les bord arrondis, les couleurs pastels, les ptit boutons
Chat type MSN [ par Jielde ]
Voila je cherche des personnes pour faire un chat type msn, ICQ, Aim,... comme VBfrance Messenger ( dont je ne remerci pas pour n'avoir pas voullu no
composant msn [ par Kevergeek ]
comment s'appelle le composant msn ? je ne le trouve po...et si je ne l'ai pa, où est-ce que je pe le trouveer ? merci(msn est installé et fonctionne)
lien avec MSN [ par diablosv ]
je voudrait faire un lien avec msn cela est il possible via le VBex : rajouter des messages d'attenteMERCI bcp
Rechreche composant MSN messenger!!!!! [ par Amano ]
Voilà c'est con mais il me manque la librairie d'MSN messenger et je la trouve pas sur le net.Alors je fais appelle a votre générosité pour m'envoyer
|
Derniers Blogs
GESTION D'EXCEPTION AVEC LES TASKSGESTION D'EXCEPTION AVEC LES TASKS par richardc
Nous avons vu dans un précédent article comment utiliser Task pour effectuer des opérations dans un autre thread.
Malheureusement, comme tout le monde n'est pas parfait, il se peut que cette exécution se passe mal et qu'une exception se produise.
La...
Cliquez pour lire la suite de l'article par richardc DéMARRONS AVEC LES TASKSDéMARRONS AVEC LES TASKS par richardc
Que vous le vouliez ou non, le développement multi-tâche est maintenant une obligation pour toute nouvelle application. Il est donc vital d'en comprendre les mécanismes et de s'y mettre le plus tôt possible.
En attendant le .NET Framework 4.5 avec le...
Cliquez pour lire la suite de l'article par richardc SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPSSLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko
Retrouvez les slides et les démo de ma session Fast & Furious XAML Apps. A ceux qui se posent la question : "est-ce que le code de la DataGrid est disponible?", je vous répondrais "pas encore". Je vais mettre en place un projet codeplex pour part...
Cliquez pour lire la suite de l'article par Vko XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|