PROFIL BINAIRE D'UN OBJET

Private arrayProfil() As String = {"Las Vegas", "Russe", "modestie", "géographie", "médecine", "PHP", "Humour", "VTT"}
Private nbOptions As Integer = arrayProfil.Length
Private longProfil As ULong = 0

' ===== 1) On affiche le catalogue des BOOLEENS :
Sub Form_Load (...) 
    Dim i As Integer
    Dim top As Integer = 10
    Dim c As ULong = 1
    Dim chb As CheckBox
    For i = 0 To UBound(arrayProfil)
        chb = New CheckBox
        chb.Tag = c
        chb.Text = arrayProfil(i)
        chb.Top = top
        chb.Left = 10
        top += chb.Height 
        ' attention au dépassement de capacité !
        If i < nbOptions - 1 Then c *= 2
        Controls.Add(chb)
    Next
End Sub

' ===== 2) On capte le profil NUMERIQUE :
Sub Profil_in(...) 
    longProfil = 0
    Dim ctl As Control
    Dim chb As CheckBox 
    ' profil = somme des CheckBox.Checked
    For Each ctl In Controls
        If TypeOf ctl Is CheckBox Then
            chb = ctl
            If chb.Checked Then longProfil += CType(chb.Tag, ULong)
        End If
    Next
    ' et là, on enregistre le profil dans 1 colonne de SQLServer (bigint) ou Access (Long) ... 	
End Sub

' ===== 3) On Affiche le profil STRING :
Sub Profil_out(...)
    ' ok, on a extrait de la BdD le Profil (longProfil) du sujet en question ... 	
    Dim Sujet As String = "Marcel TCHCONST"
    Dim strProfil As String = ""
    Dim binProfil As String = ""
    ' Conversion NUMERIQUE > BINAIRE :
    binProfil = CBinaire(longProfil)
    If longProfil = 0 Then
        MsgBox("ne s'intéresse à rien !", 16, Sujet)
        Exit Sub
    End If
    ' Conversion BINAIRE > BOOLEEN > STRING : 
    For i = 1 To nbOptions
        strProfil &= IIf(CBool(Mid(binProfil, i, 1)), arrayProfil(i - 1) & ", ", "")
    Next
    ' mise en forme sophisticated :
    ' cad: remplacement des derniers caractères par "." et remplacement de la dernière virgule par "et" :
    Dim ToTrim() As Char = {",", " "}
    strProfil = strProfil.Trim(ToTrim) & "."
    Dim pos_virgule As Integer = InStrRev(strProfil, ",") 
    If pos_virgule Then
        strProfil = Mid(strProfil, 1, pos_virgule - 1) & " et" & Mid(strProfil, pos_virgule + 1)
    End If
    MsgBox("est champion de : " & vbCr & strProfil, 64, Sujet)
End Sub

' ===== La Conversion en Binaire :
Private Function CBinaire(ByVal _Val As ULong) As String
        Dim strBin As String = ""
        Dim invBin As String = ""
        ' 1) Convertir en binaire :
        Do
            Try
                strBin = (_Val Mod 2).ToString & strBin
                _Val \= 2
            Catch ex As OverflowException
                MsgBox(ex.Message)
                End
            End Try
        Loop Until _Val = 0
        ' 2) compléter à gauche avec des Zéros :
        strBin = strBin.PadLeft(nbOptions, "0")
        ' 3) et inverser :
        Return StrReverse(strBin)
    End Function