Soyez le premier à donner votre avis sur cette source.
Vue 3 636 fois - Téléchargée 372 fois
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' clsPermutaion '' Written by : Christophe POLLET '' '' Modifications : '' - 25. jun. 2002 by Christophe POLLET : Starting developpement '' '' Description : '' Searches for the permutations of some letters '' '' Copyright : Christophe POLLET '' '' Contact : '' - Christophe POLLET : <seyev@infomaniak.ch> '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''' PUBLICS DATAS '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''' PRIVATES DATAS Private gcLetters As New Collection ' The letters Private gsWords() As String ' The words Private gsTempWords() As String ' Private gsSeparator As String ' The separator Private gdNumberOfPermutations As Double ' Private gcListBox As ListBox ' Private gcTextBox As TextBox ' Private gbUseListBox As Boolean ' Private gbUseTextBox As Boolean ' Private gbFound As Boolean ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''' PUBLICS EVENTS Public Event NewPermutation(dCurrentNumber As Double) Public Event NewPrint(dCurrentNumber As Double) Public Event SearchDone() Public Event PrintDone() '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''' PUBLIC PROPERTIES Public Property Let Letters(ByVal sLetters As String) Dim sLettersArray() As String Dim N As Integer sLettersArray = Split(sLetters, gsSeparator, -1, vbTextCompare) For N = gcLetters.Count To 1 Step -1 gcLetters.Remove (N) Next N For N = 0 To UBound(sLettersArray) Call gcLetters.Add(sLettersArray(N)) Next N gdNumberOfPermutations = GetNumberOfPermutations(gcLetters.Count) gbFound = False End Property Public Property Get Letters() As String Dim sLettersArray() As String Dim N As Integer ReDim sLettersArray(gcLetters.Count - 1) For N = 1 To gcLetters.Count sLettersArray(N - 1) = gcLetters.Item(N) Next N Letters = Join(sLettersArray, gsSeparator) End Property Public Property Let Separator(ByVal sSeparator As String) If sSeparator <> "" Then gsSeparator = sSeparator Else MsgBox ("clsPermutaion::Separator : cannot use null separator") End If End Property Public Property Get Separator() As String Separator = gsSeparator End Property Public Property Let UseListBox(ByRef cListBox As ListBox) Set gcListBox = cListBox gbUseListBox = True End Property Public Property Let UseTextBox(ByRef cTextBox As TextBox) Set gcTextBox = cTextBox gbUseTextBox = True End Property Public Property Get NumberOfLetters() As Long NumberOfLetters = gcLetters.Count End Property Public Property Get NumberOfPermutations() As Double NumberOfPermutations = gdNumberOfPermutations End Property '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''' PRIVATES METHODS Private Sub Class_Initialize() gsSeparator = " " gbUseListBox = False gbUseTextBox = False gbFound = False End Sub Private Function GetNumberOfPermutations(ByVal lNumberOfLetters As Long) As Double Dim Result As Double Dim N As Long If (lNumberOfLetters < 0) Or (lNumberOfLetters > 170) Then Call MsgBox("Number too high : " & CStr(lNumberOfLetters), vbCritical + vbOKOnly, "clsPermutation") Exit Function End If Result = 1 For N = 1 To lNumberOfLetters Result = Result * N Next GetNumberOfPermutations = Result End Function Private Sub GetPermutations(cLetters As Collection) Dim N As Long Dim cTempLetters As New Collection Dim lCurrent As Long DoEvents lCurrent = UBound(gsTempWords) For N = 1 To cLetters.Count Call CopyCollection(cLetters, cTempLetters) gsTempWords(lCurrent) = gsTempWords(lCurrent - 1) & cTempLetters(N) cTempLetters.Remove (N) If cTempLetters.Count = 0 Then gsWords(UBound(gsWords)) = gsTempWords(lCurrent) ReDim Preserve gsWords(UBound(gsWords) + 1) ReDim Preserve gsTempWords(lCurrent - 1) RaiseEvent NewPermutation(CDbl(UBound(gsWords))) Exit Sub End If ReDim Preserve gsTempWords(lCurrent + 1) Call GetPermutations(cTempLetters) Next N End Sub Private Sub CopyCollection(cFrom As Collection, cTo As Collection) Dim N As Long For N = cTo.Count To 1 Step -1 cTo.Remove (N) Next N For N = 1 To cFrom.Count Call cTo.Add(cFrom.Item(N)) Next N End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''' PUBLICS METHODS Public Sub printPermutations(ByVal bUseDefaut, _ Optional ByVal bUseListBox As Boolean = False, _ Optional bUseTextBox As Boolean = False) Dim N As Long If Not gbFound Then Call MsgBox("Permutations must be found before calling Permutation::printPermutation", vbOKOnly + vbCritical, "clsPermtuation") Exit Sub End If For N = 0 To UBound(gsWords) RaiseEvent NewPrint(CDbl(N)) DoEvents If bUseDefaut Then If gbUseListBox Then gcListBox.AddItem (gsWords(N)) If gbUseTextBox Then gcTextBox.Text = gcTextBox.Text & vbCrLf & gsWords(N) Else If bUseListBox And gbUseListBox Then gcListBox.AddItem (gsWords(N)) If bUseTextBox And gbUseListBox Then gcTextBox.Text = gcTextBox.Text & vbCrLf & gsWords(N) End If Next N RaiseEvent NewPrint(CDbl(N)) RaiseEvent PrintDone End Sub Public Sub searchPermutations() ReDim gsTempWords(1) ReDim gsWords(0) Call GetPermutations(gcLetters) ReDim Preserve gsWords(UBound(gsWords) - 1) ReDim gsTempWords(0) gbFound = True RaiseEvent SearchDone End Sub
2 oct. 2004 à 20:55
merci pour tes guggestions, je vais y penser quand je ne sauvrai pas quoi faire... Mais ces temps j'au deux "gros" projets en PHP, et je n'ai plus fait de VB depuis pas mal de temps....
Enfin si j'ai l'occasion, je le fait, merci !
2 oct. 2004 à 18:00
- Mettre également l'évolution en % (c'est plus parlant lorsqu'on a une grande quantité de possibilités) ;
- Mettre un bouton permettant d'interrompre la recherche.
27 juin 2002 à 15:16
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.