Soyez le premier à donner votre avis sur cette source.
Snippet vu 4 279 fois - Téléchargée 20 fois
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
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.