Calcul de la factorielle d'un nombre avec tous ses chiffres (aucune limite !)

Télécharger le projet
Commenter

Description

Ce code permet de calculer la factorielle d'un nombre et de stocker le résultat dans un fichier *.txt.
La factorielle est calculée avec TOUS ses chiffres, et vous pouvez calculer la factorielle que vous voulez! (aucune limite ) Oubliez TOUT ce que vous avez vu sur ce site en matière de calcul de factorielle, voici LE programme dans ce domaine.

Source / Exemple : 

'pour ceux qui ne veulent pas télécharger; mettez cette source dans un bloc-notes et renommez le fichier en *.frm

VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFC0C0&
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Calcul de factorielle"
   ClientHeight    =   585
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   5325
   BeginProperty Font 
      Name            =   "MS Serif"
      Size            =   6.75
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   585
   ScaleWidth      =   5325
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   1680
      TabIndex        =   1
      Top             =   120
      Width           =   2295
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00FFC0C0&
      Caption         =   "Calculer"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFC0C0&
      Caption         =   "Factorielle à calculer"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1575
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'définition des variables
Dim N, R(100000), M, MAX, K, RET, S, B, A, C2, C1, E4, E5, B2, L, L1, C, bouc1, bouc2, bouc3, bouc4, CX, CY As Double
Dim ef As String
Dim MAIN As Double  'pour rendre la main

Private Sub Command1_Click()
If N <= 0 Then MsgBox "Nombre incorrect", vbCritical: Text1.Text = vbNullString: Exit Sub 'vérification de N
'initialisation des variables
R(1) = 0.00001: M = 2: CX = 0: CY = 0: bouc1 = 1: bouc2 = 1: bouc3 = 1: bouc4 = 1: MAX = 1: E5 = 100000: E4 = 10000

Do While M <= N

DebutWhile:
    
    'compteur pour rendre la main de tps en tps
    MAIN = MAIN + 1
    If (MAIN Mod 100000) = 0 Then
        DoEvents
        Me.Caption = (M / N * 100) & " %"   'a enlever pour ceux qui veulent + de speed
    End If
    
    CAl1    'premiere série de calculs
    
    If B2 >= E4 Then
        'deuxième série
        B2 = B2 / E4
        RET = Int(B2)
        R(K) = Int(0.5 + (B2 - RET) * E4) + C1
        K = K + 1
        If K <= MAX Then GoTo DebutWhile
        R(K) = RET / E5
        MAX = MAX + 1
        If MAX > 10000 Then End
        GoTo Increm
    End If
    
    R(K) = B2 + C1
    RET = 0
    
    If K <> MAX Then
        K = K + 1
        GoTo DebutWhile
    End If
    
Increm:
    'incrémentation de M; fin de la 'multiplication'
    M = M + 1: K = 1: RET = 0
Loop

For K = MAX To 1 Step -1

    S = Int(0.5 + R(K) * E5)
    
    If S = 0 Then
        L = 8
    Else
        L = 8 - Int(Log(S + 0.5) / Log(10))
        If L = 0 Or K = MAX Then GoTo CreateString
    End If

    For L1 = 1 To L
        If (L1 Mod 500) = 0 Then DoEvents   'rend la main de tps en tps
        ef = ef & "0"
    Next L1
    DoEvents    'pour le cas ou L<500
    
CreateString:
    ef = ef & S 'rajoute le nouveau chiffre S au résultat
Next K

CreateFile  'résultat

End Sub

Private Sub Text1_Change()
'récupération de N en fct de text1.text
N = Int(Val(Text1.Text))
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
'appui de 'enter', donc lancement des calculs
If KeyCode = 13 Then Call Command1_Click
End Sub

Private Sub CAl1()
'première série de calculs
'les commentaires 'mathématiques' n'aparaissent pas encore, puisque
'je remet à jour cette source que j'ai fait il y a très longtemps, et que
'donc j'ai perdu le fil de mon algorithme
'mais çà viendra ds la prochaine mise à jour

bouc1 = bouc1 + 1
S = R(K)
B = Int(S)
A = Int(E5 * (S - B) + 0.5)
C = (RET + A * M) / E5
C2 = Int(C)
C1 = Int(E5 * (C - C2) + 0.5) / E5
B2 = B * M + C2

End Sub

Private Function CreateFile()
'fin des calculs et création du fichier texte
Open App.Path & "factorielle de " & N & " .txt" For Output As #1
    Print #1, ef    'écriture
Close #1
MsgBox "Le fichier a été créé dans " & App.Path, vbOKOnly
End 'fin
End Function

Conclusion :

le source est de moi, désolé si il est pas commenté

ah oui, le fichier résultat créé est stocké dans le répertoire du programme
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (violent_ken)