Soyez le premier à donner votre avis sur cette source.
Vue 4 515 fois - Téléchargée 343 fois
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
20 avril 2005 à 02:42
19 avril 2005 à 17:45
Un grand merci pour ta fonction qui m'a été très utile (conversion RGB - HEXA pour VB). 10 !
Bien à toi,
Cacophrène
7 avril 2005 à 01:46
6 avril 2005 à 22:59
6 avril 2005 à 08:45
Debug.Print Hex(RGB(Rouge,Vert,Bleue))
...
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.