CONVERTISSEUR DE CODES COULEUR DÉCIMAL - HEXADÉCIMAL - RGB

Dim TxtF As Integer
Dim Temp As Integer

Private Sub Form_Load()
    TxtF = 1
    Conversion (3)
End Sub

Private Sub AscenseurDéc_Change()
    Call AscenseurDéc_Scroll
End Sub

Private Sub AscenseurDéc_Scroll()
    Dim AD As Long
    AD = AscenseurDéc.Value
    AD = (1000 * AD) + -999
    Text1.Text = Trim(Str(AD))
    Conversion (1)
End Sub

Private Sub BoutonOK_Click()
    Conversion (TxtF)   'TxtF est le choix du Focus : La TextBox qui a le focus garde sa valeur et les autres TextBox changent de valeur en fonction de celle-ci
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    Temp = Text1.SelStart
    If KeyCode = vbKeyBack And Text1.SelStart <> 0 Then
        Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1)
        Text1.SelStart = Temp - 1
    End If
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
    Temp = Text2.SelStart
    If KeyCode = vbKeyBack And Text2.SelStart <> 0 Then
        Text2.Text = Left(Text2.Text, Len(Text2.Text) - 1)
        Text2.SelStart = Temp - 1
    End If
End Sub

Private Sub Text3_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Temp = Text3(Index).SelStart
    If KeyCode = vbKeyBack And Text3(Index).SelStart <> 0 Then
        Text3(Index).Text = Left(Text3(Index).Text, Len(Text3(Index).Text) - 1)
        Text3(Index).SelStart = Temp - 1
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If InStr("0123456789" & vbKeyBack & vbKeyDelete, Chr(KeyAscii)) = 0 Then KeyAscii = 0    'Filtrage de la saisie
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If InStr("0123456789abcdefABCDEF" & vbKeyDelete, Chr(KeyAscii)) = 0 Then KeyAscii = 0   'Filtrage de la saisie
    If InStr("abcdef", Chr(KeyAscii)) Then KeyAscii = KeyAscii - 32
End Sub

Private Sub Text3_KeyPress(Index As Integer, KeyAscii As Integer)
    If InStr("0123456789" & vbKeyDelete, Chr(KeyAscii)) = 0 Then KeyAscii = 0   'Filtrage de la saisie
End Sub

Private Sub Text1_Validate(Cancel As Boolean)
    If Text1.Text = "" Then Text1.Text = "00000001"
    Formatage
End Sub

Private Sub Text2_Validate(Cancel As Boolean)
    If Text2.Text = "" Then Text2.Text = "000000"
    Formatage
End Sub

Private Sub Text3_Validate(Index As Integer, Cancel As Boolean)
    If Text3(Index).Text = "" Then Text3(Index).Text = "000"
    Formatage
End Sub

Private Sub Text1_GotFocus()
    TxtF = 1
End Sub

Private Sub Text2_GotFocus()
    TxtF = 2
End Sub

Private Sub Text3_GotFocus(Index As Integer)
    TxtF = 3
End Sub

Private Sub UpDown1_Change(Index As Integer)
    Text3(Index).Text = Format(Text3(Index).Text, "000")
    Conversion (3)
End Sub

Private Sub UpDown2_Change(Index As Integer)
    Text4(Index).Text = Format(Text4(Index).Text, "000")
    Conversion (4)
End Sub

Sub Conversion(TxtFormat)
    On Error Resume Next    'Facultatif sauf si le code comporte des bugs (??)
    Formatage
    Select Case TxtFormat
        Case 1
            Text3(2).Text = Trim(Str(Int(Val(Text1.Text) / 65536)))
            Text3(1).Text = Trim(Str(Int((Val(Text1.Text) - 65536 * Val(Text3(2).Text)) / 256)))
            Text3(0).Text = Trim(Str(Int(Val(Text1.Text) - 65536 * Val(Text3(2).Text) - 256 * Val(Text3(1).Text))))
            Text2.Text = Hex(Text1.Text - 1)
        Case 2
            For i% = 5 To 0 Step -1
                If Asc(Mid(Text2.Text, i% + 1, 1)) > 64 Then Text3(Int(i% / 2)).Text = Trim(Str(Val(Text3(Int(i% / 2)).Text) + (Asc(Mid(Text2.Text, i% + 1, 1)) - 55) * (16 ^ Abs(Round((i% / 2) - Int(i% / 2) + 0.1) - 1)))) Else Text3(Int(i% / 2)).Text = Trim(Str(Val(Text3(Int(i% / 2)).Text) + Val(Mid(Text2.Text, i% + 1, 1) * (16 ^ Abs(Round((i% / 2) - Int(i% / 2) + 0.1) - 1)))))
                Text1.Text = Trim(Str(Val(Text3(0).Text) + Val(Text3(1).Text) * 256 + Val(Text3(2).Text) * 65536 + 1))
            Next i%
        Case 3
            Text1.Text = Trim(Str(Val(Text3(0).Text) + Val(Text3(1).Text) * 256 + Val(Text3(2).Text) * 65536 + 1))
            Text2.Text = Hex(Text1.Text - 1)
        Case 4
            'en attente
    End Select
    PictureAperçu(0).BackColor = "&H" + Text2.Text
    PictureAperçu(1).BackColor = "&H" & Hex((Val(Text3(0).Text) + Val(Text3(1).Text) + Val(Text3(2).Text)) / 3) & Hex((Val(Text3(0).Text) + Val(Text3(1).Text) + Val(Text3(2).Text)) / 3) & Hex((Val(Text3(0).Text) + Val(Text3(1).Text) + Val(Text3(2).Text)) / 3)
    Formatage
End Sub

Sub Formatage()
    If Val(Text1.Text) > 16777216 Then Text1.Text = "16777216"  'Eviter les dépassements de valeurs
    For Each Element In Text3()
        If Val(Element.Text) > 255 Then Element.Text = "255"
    Next Element
    Text1.Text = Format(Text1.Text, "00000000")
    If Len(Text2.Text) <> 6 Then
        For i% = 0 To 5 - Len(Text2.Text)
            Text2.Text = Text2.Text & "0"
        Next i%
    End If
    For Each Element In Text3()
        Element.Text = Format(Element.Text, "000")
    Next Element
    For Each Element In Text4()
        Element.Text = Format(Element.Text, "000")
    Next Element
End Sub

Télécharger le zip