Ce code que je qualifierais d' "artisanal" est beaucoup plus utile que bien fait. Il s'addresse au débutant qui trouverons probablement utile eux aussi d'avoir un outil qui leur permettra de composer leur couleur et de pouvoir facilement les intégrer dans VB.
Source / Exemple :
Dim RGBRed As Integer
Dim RGBGreen As Long
Dim RGBBlue As Long
Dim DecRed As Integer
Dim DecGreen As Long
Dim DecBlue As Long
Dim Dec As Long
Dim Hex As String
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim e As String
Dim f As String
Private Sub Command1_Click()
Restart:
RGBRed = RedBox.Text
RGBGreen = GreenBox.Text
RGBBlue = BlueBox.Text
Select Case RGBRed
Case Is > 255
RedBox.Text = "255"
GoTo Restart
Case Is < 0
RedBox.Text = "0"
GoTo Restart
End Select
Select Case RGBGreen
Case Is > 255
GreenBox.Text = "255"
GoTo Restart
Case Is < 0
GreenBox.Text = "0"
GoTo Restart
End Select
Select Case RGBBlue
Case Is > 255
BlueBox.Text = "255"
GoTo Restart
Case Is < 0
BlueBox.Text = "0"
GoTo Restart
End Select
GetDecimal
End Sub
Private Sub GetHex()
Dim WouldB As Long
Dim NewDec As Long
a = 0
b = 0
c = 0
d = 0
e = 0
f = 0
If Not Dec < 16 And Not Dec = 0 Then
NewDec = Int(Dec / 16)
WouldB = NewDec * 16
a = Dec - WouldB
Dec = NewDec
Else
a = Dec
b = 0
c = 0
d = 0
e = 0
f = 0
Dec = 0
HexArrangement
End If
If Not Dec < 16 And Not Dec = 0 Then
NewDec = Int(Dec / 16)
WouldB = NewDec * 16
b = Dec - WouldB
Dec = NewDec
Else
b = Dec
c = 0
d = 0
e = 0
f = 0
Dec = 0
HexArrangement
End If
If Not Dec < 16 And Not Dec = 0 Then
NewDec = Int(Dec / 16)
WouldB = NewDec * 16
c = Dec - WouldB
Dec = NewDec
Else
c = Dec
d = 0
e = 0
f = 0
Dec = 0
HexArrangement
End If
If Not Dec < 16 And Not Dec = 0 Then
NewDec = Int(Dec / 16)
WouldB = NewDec * 16
d = Dec - WouldB
Dec = NewDec
Else
d = Dec
e = 0
f = 0
Dec = 0
HexArrangement
End If
If Not Dec < 16 And Not Dec = 0 Then
NewDec = Int(Dec / 16)
WouldB = NewDec * 16
e = Dec - WouldB
Dec = NewDec
Else
e = Dec
f = 0
Dec = 0
HexArrangement
End If
If Not Dec < 16 And Not Dec = 0 Then
NewDec = Int(Dec / 16)
WouldB = NewDec * 16
f = Dec - WouldB
Dec = NewDec
Else
f = Dec
Dec = 0
HexArrangement
End If
End Sub
Public Function GetDecimal() As Currency
Label1.Caption = "Valeur RVB(RGB) : " & RGBRed & ", " & RGBGreen & ", " & RGBBlue
DecRed = RGBRed
DecGreen = RGBGreen * 256
DecBlue = RGBBlue * 65536
Dec = DecRed + DecGreen + DecBlue
Label2.Caption = "Valeur Décimale : " & Dec
GetHex
End Function
Private Sub HexArrangement()
Select Case a
Case 10
a = "A"
Case 11
a = "B"
Case 12
a = "C"
Case 13
a = "D"
Case 14
a = "E"
Case 15
a = "F"
End Select
Select Case b
Case 10
b = "A"
Case 11
b = "B"
Case 12
b = "C"
Case 13
b = "D"
Case 14
b = "E"
Case 15
b = "F"
End Select
Select Case c
Case 10
c = "A"
Case 11
c = "B"
Case 12
c = "C"
Case 13
c = "D"
Case 14
c = "E"
Case 15
c = "F"
End Select
Select Case d
Case 10
d = "A"
Case 11
d = "B"
Case 12
d = "C"
Case 13
d = "D"
Case 14
d = "E"
Case 15
d = "F"
End Select
Select Case e
Case 10
e = "A"
Case 11
e = "B"
Case 12
e = "C"
Case 13
e = "D"
Case 14
e = "E"
Case 15
e = "F"
End Select
Select Case f
Case 10
f = "A"
Case 11
f = "B"
Case 12
f = "C"
Case 13
f = "D"
Case 14
f = "E"
Case 15
f = "F"
End Select
Hex = f + e + d + c + b + a
Result.Text = "&H00" & Hex$
'Petit exercice pour les plus callés: Trouvez une façon d'optimiser ce code
Dim EstiDeVariableQuiSertARienSaufARalentirLeProgramme As String
EstiDeVariableQuiSertARienSaufARalentirLeProgramme = "&H00" & Hex$
lbpreview.BackColor = EstiDeVariableQuiSertARienSaufARalentirLeProgramme$
'Fin de l'exercice, mais si ca vous chante, vous pouvez continuer...
End Sub
Private Sub Form_Load()
Label8.Caption = "B" & vbNewLine & "r" & vbNewLine & "i" & vbNewLine & "l" & vbNewLine & "l" & vbNewLine & "a" & vbNewLine & "n" & vbNewLine & "c" & vbNewLine & "e"
End Sub
Private Sub Label4_Click()
RedBox.Text = RedBox.Text + 10
GreenBox.Text = GreenBox.Text + 10
BlueBox.Text = BlueBox.Text + 10
Command1_Click
End Sub
Private Sub Label4_DblClick()
RedBox.Text = RedBox.Text + 10
GreenBox.Text = GreenBox.Text + 10
BlueBox.Text = BlueBox.Text + 10
Command1_Click
End Sub
Private Sub Label5_Click()
RedBox.Text = RedBox.Text + 1
GreenBox.Text = GreenBox.Text + 1
BlueBox.Text = BlueBox.Text + 1
Command1_Click
End Sub
Private Sub Label5_DblClick()
RedBox.Text = RedBox.Text + 1
GreenBox.Text = GreenBox.Text + 1
BlueBox.Text = BlueBox.Text + 1
Command1_Click
End Sub
Private Sub Label6_Click()
RedBox.Text = RedBox.Text - 1
GreenBox.Text = GreenBox.Text - 1
BlueBox.Text = BlueBox.Text - 1
Command1_Click
End Sub
Private Sub Label6_DblClick()
RedBox.Text = RedBox.Text - 1
GreenBox.Text = GreenBox.Text - 1
BlueBox.Text = BlueBox.Text - 1
Command1_Click
End Sub
Private Sub Label7_Click()
RedBox.Text = RedBox.Text - 10
GreenBox.Text = GreenBox.Text - 10
BlueBox.Text = BlueBox.Text - 10
Command1_Click
End Sub
Private Sub Label7_DblClick()
RedBox.Text = RedBox.Text - 10
GreenBox.Text = GreenBox.Text - 10
BlueBox.Text = BlueBox.Text - 10
Command1_Click
End Sub
Private Sub RedBox_KeyPress(KeyAscii As Integer)
If InStr("1234567890" & Chr(8), Chr$(KeyAscii)) = 0 Then 'Ce code a été trouvé sur www.Codes-Sources.com et l'auteur est "Je m'en rappel plus et je le retrouve pas"
KeyAscii = 0
End If
End Sub
Private Sub GreenBox_KeyPress(KeyAscii As Integer)
If InStr("1234567890" & Chr(8), Chr$(KeyAscii)) = 0 Then 'Ce code a été trouvé sur www.Codes-Sources.com et l'auteur est "Je m'en rappel plus et je le retrouve pas"
KeyAscii = 0
End If
End Sub
Private Sub BlueBox_KeyPress(KeyAscii As Integer)
If InStr("1234567890" & Chr(8), Chr$(KeyAscii)) = 0 Then 'Ce code a été trouvé sur www.Codes-Sources.com et l'auteur est "Je m'en rappel plus et je le retrouve pas"
KeyAscii = 0
End If
End Sub
Conclusion :
Le code n'est pas très optimisé et je l'ai fait il y a un bout de temps, mais de toute facon, il est tellement petit, qu'on s'en fou bien si sa prend 0,04 seconde au lieu de 0,01, non?
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.