نوشتن الگوریتم تر کیب اعداد

[S.Azish]

Option Explicit 



Private Sub Form_Load() 

' 

    Dim orgNumbers(6) As Integer 

    Dim nNumbers() As String 

    Dim i As Double 

    

    

    orgNumbers(0) = 1 

    orgNumbers(1) = 2 

    orgNumbers(2) = 3 

    orgNumbers(3) = 4 

    orgNumbers(4) = 5 

    orgNumbers(5) = 6 

    orgNumbers(6) = 7 

    'orgNumbers(7) = 8 

    'orgNumbers(8) = 9 

    'orgNumbers(9) = 0 

    

    nNumbers = CreateMultipleCases(orgNumbers) 

    

    List1.AddItem "Total numbers of cases: " & UBound(nNumbers) + 1   ' which is I! 

    

    For i = 0 To UBound(nNumbers) 

        List1.AddItem nNumbers(i) 

    Next 

    

' 

End Sub 



Private Function CreateMultipleCases(eNumbers() As Integer) As String() 

' 



    Dim i As Byte 

    Dim a As Byte 

    Dim j As Double 

    Dim iItemsCount As Integer 

    Dim eNewNumbers() As Integer 

    Dim eResult() As String 

    Dim fResult() As String 

    Dim iCounter As Double 

    

    iItemsCount = UBound(eNumbers) + 1 

    



    If iItemsCount > 1 Then  'For the last digit 

        ReDim eNewNumbers(iItemsCount - 2) As Integer 

            

        For a = 0 To iItemsCount - 1 

            Swap eNumbers(0), eNumbers(a) 

            For i = 1 To iItemsCount - 1 

                eNewNumbers(i - 1) = eNumbers(i) 

            Next 

            eResult = CreateMultipleCases(eNewNumbers) 

            For j = 0 To UBound(eResult) 

                ReDim Preserve fResult(iCounter) As String 

                fResult(iCounter) = eNumbers(0) & eResult(j) 

                iCounter = iCounter + 1 

            Next 

        Next 

    Else 

        ReDim fResult(0) As String 

        fResult(0) = eNumbers(0) 

    End If 

    

    CreateMultipleCases = fResult 

' 

End Function 



Private Sub Swap(ByRef Number_1 As Integer, ByRef Number_2 As Integer) 

' 

    Dim tmpInt As Integer 

    

    tmpInt = Number_1 

    Number_1 = Number_2 

    Number_2 = tmpInt 

' 

End Sub