Accueil > > > CALCUL DE LA FACTORIELLE D'UN NOMBRE AVEC TOUS SES CHIFFRES (AUCUNE LIMITE !)
CALCUL DE LA FACTORIELLE D'UN NOMBRE AVEC TOUS SES CHIFFRES (AUCUNE LIMITE !)
Information sur la source
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
- '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
'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é Aucun bug connu, mais si vous avez des questions ==> alaindescotes@hotmail.fr
ah oui, le fichier résultat créé est stocké dans le répertoire du programme
Historique
- 05 août 2005 21:03:19 :
- C'est pas une mise à jour mais un changement total. Multiplié la vitesse par environ 1.8 , code commenté, clair, mieux programmé. La totale quoi. Et cela en réponse de la remarque de Jack. J'espère que la source vous satisfera mieux.
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Lecture chiffre par chiffre d'un fichier ! [ par ZogStriP ]
Bonjour tout le monde et Joyeux Noël !!Je voudrais savoir comment faire pour lire un tableau de chiffres d'un fichier !!Exemple : (contenue de monFich
Connaitre le nombre de connections réseau à un fichier [ par ericboul ]
Bonjour,J'ai une application Access 2000 et par le biais du VBA, je voudrais (sans passer par le fichier 'ldb') connaitre le nombre de connections rés
lire un nombre de caractères [ par titoine2000 ]
Bonjour,Comment faire pour lire un certain nombre de caractères d'un fichier a partir d'un nombre de caractères, je m'expliqueex: comment lire les 500
Sauvegarde données en binaire [ par freeman151248 ]
Bonjour,je souhaite sauvegarder un nombre de données assez important, donc en binaire pour ne pas avoir de taille de fichier trop lourde. Mais je n'ar
renommer un fichier en fonction de son nombre de lignes [ par sabyann ]
Bonjour,J'ai plusieurs fichiers nommés par exemple toto.txt, tata.txt, titi.txt...Par exemple si toto contient 5 lignes, je voudrai que le nombre de l
Protection des macros [ par falafala ]
Bonjour à tous, J'ai réalisé un fichier Excel avec un certain nombre de Macros.Je vais devoir passer ce fichier à un certain nombre de personnes et ça
Comment connaitre le nombre de lignes d'un fichier texte? [ par faucheuse ]
Bonjour ami(e)s programmeurs et programmeuzes, Alors voila j'aurai voulu savoir si il existait une fonction en VBA pour connaitre le nombre de lignes
[VB6]Ecrire dans un fichier organisé [ par simgoku ]
Bonjour a tous, J'ai déja posté a propos des fichiers texte pour en savoir un petit peu plus, mais la j'ai une demande bien particuliére et je ne trou
probleme dans la lecture d'un fichier txt [ par biker45 ]
Bonjour, voila, j'ai un petit probleme concernant la lecture d'un fichier, voici le début du fichier pour que vous compreniez mon probleme:" Area
|
Derniers Blogs
ASYNC/AWAIT: COMPRENDRE COMMENT CA MARCHEASYNC/AWAIT: COMPRENDRE COMMENT CA MARCHE par fathi
Tout le monde est unanime pour dire que la programmation multi-thread et asynchrone est en train de devenir un sujet incontournable. Beaucoup de choses sont arrivées avec le framework 4 pour le code parallèle (TPL, PLinq,.) et bientôt, on va avoir l...
Cliquez pour lire la suite de l'article par fathi PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS !PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS ! par Etienne Margraff
J'ai récemment eu un problème pour obtenir l'intelliTrace sur un site web dans IIS. Il n'y avait pas de message d'erreur, rien dans le journal d'évènement Windows, et après 3 appels à une voyante, 2 visites chez un marabou, j'ai failli me résign...
Cliquez pour lire la suite de l'article par Etienne Margraff OFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONSOFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONS par junarnoalg
De nombreuses entreprises font le choix de SharePoint Online, service fourni au travers de l'offre de Microsoft Office 365. S'il est vrai que ce choix apporte un grand nombre d'avantages; rapidité de mise en œuvre, disponibilité, large couvertu...
Cliquez pour lire la suite de l'article par junarnoalg PRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGEPRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGE par richardc
http://www.c2idotnet.com/articles/presentation-des-api-rest-de-windows-azure-lister-les-comptes-de-storage
Désolé pour "toto", mais c2i existait avant blogs.developpeur.org et c'est mon site "officiel" ;-) ...
Cliquez pour lire la suite de l'article par richardc
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|