Remerciez-le!

Remerciez @Admin pour avoir partagé cet document gratuitement, de la manière la plus simple, en partageant sur les réseaux sociaux.

Application 1 {Permutation de 2 variables} Program permutation; uses wincrt; va

Application 1 {Permutation de 2 variables} Program permutation; uses wincrt; var a,b,c : integer; {***********************************} procedure permut2(var a,b : integer); begin {Permutation sans avoir recour à une troisième variable} a:=a+b; b:=a-b; a:=a-b; end; {***********************************} begin write('Donner a : '); readln(a); write('Donner b : '); readln(b); c:=a; a:=b; b:=c; writeln('La nouvelle valeur de a est : ',a); write('La nouvelle valeur de b est : ',b); end. Index Application 2 Program calcul_aire; uses wincrt; Const pi=3.14; var r,c,s_hachuree,s_triangle,s_cercle : real; begin write ('donner le rayon du cercle : '); read(r); write ('donner le côté du triangle : '); read(c); s_cercle := pi * SQR(r); s_triangle := SQRT(3) / 4 * SQR(c); s_hachuree := s_cercle - s_triangle /3; write('l''aire de la surface hachurée est : ',s_hachuree:4:2); end. Index Application 3 {CH1 Ex12 page 23 - 4Sc 07 - 08} {Changer la casse des caractères d'une chaine} {conversion d'un caractère miniscul en majuscul} program min_maj; uses wincrt; var ch, maj : string; i : integer; begin writeln('Donner une chaine :'); readln(ch); maj:=''; for i:=1 to length(ch) do if ch[i] in ['a'..'z'] then maj:= maj + Chr(Ord(ch[i])-32) else maj:= maj + ch[i]; write('Aprés changement de la casse : ',maj); end. Index Application 4 {4 Sc Rappel Type énuméré et vecteur - Paye de la semaine} {calcul de la paye d'un ouvrier et création d'un type énuméré jours} {création d'un type interval jours_de_travail} program paye_semaine; uses wincrt; Type jours = (dimanche, lundi, mardi, mercredi, jeudi, vendredi, samedi); jours_de_travail = lundi..vendredi; t_horaire_semaine = array[jours_de_travail] of integer; var t : t_horaire_semaine; j : jours_de_travail; total :integer; ps,thp :real; begin for j:= lundi to vendredi do begin writeln('Entrez le nombre d''heure du jour ',ord(j),' : '); readln(t[j]); total:= t[j] + total; end; writeLN('Précisez la valeur du taux horaire : '); readln(thp); PS:= total * thp; write('La paye de la semaine est : ',PS:3:3, ' DT'); end. Index Application 5 {calcul de l'inverse d'un entier à 2 chiffres CH 2 Les actions élémentaires simples } Program inverse; uses wincrt; var n,m: integer; begin write('Donner un entier : '); readln(n); m:= (n div 10)+(n mod 10) *10; write('L''inverse est :',m); end. Index Application 6 {Structure de contrôle conditionnelle simple - forme réduite. } program recherche; uses wincrt; var c:char; ch,msg:string; begin readln(c); readln(ch); msg:='Le caractère n''existe pas'; if pos(c,ch)<>0 then msg:='Le caractère existe '; write(msg); end. Index Application 7 version 1 {Saisir une chaîne de caractère et vérifier si elle est composée de plusieurs mots.} {version 1} program phrase; uses wincrt; var ch:string; begin writeln('Donner une chaîne : '); readln(ch); if POS (' ',ch) = 0 then writeln('Votre chaîne est composée d''un seul mot ') else writeln('Votre chaîne est composée de plusieurs mots '); end. Index Application 8 version 2 {structure de contrôle conditionnelle forme généralisée.} program phrase; uses wincrt; var ch:string; procedure efface_esp_deb(var ch:string); begin while (ch[1]=' ') and (length(ch)<>0) do {supprimer tous les espaces de début} delete(ch, 1, 1); end; procedure efface_esp_fin(var ch:string); begin while (ch[length(ch)]=' ') and (length(ch)<>0) do {supprimer tous les espaces de fin} delete (ch,length(ch), 1); end; { ********* PP ***********} begin writeln('Donner une chaîne : '); readln(ch); efface_esp_deb(ch); efface_esp_fin(ch); if length(ch)= 0 then writeln('Votre chaîne est vide ') else if POS (' ',ch) = 0 then writeln('Votre chaîne est composée d''un seul mot ') else writeln('Votre chaîne est composée de plusieurs mots '); end. Index Application 9 heure système {Avancer l'heure système d'une seconde} program inc_heure_systeme; uses wincrt,windos; var h,m,s,c:word; bip:char; msg:string; begin gettime(h,m,s,c); {Pour tester le cas particulier 23:59:59} {h:=23; m:=59; s:=59;} writeln(h,':',m,':',s); if s<59 then inc(s,1) else if m<59 then begin s:=0; inc(m,1); end else if h<23 then begin s:=0; m:=0; inc(h,1); end else begin s:=0; m:=0; h:=0; end; gotoxy(38,12); write(h,':',m,':',s); end. Index Application 10 { Affiche la saison selon le mois saisi Structure de contrôle conditionnelle à choix} Program saisons; uses wincrt; var mois : integer; begin write('Donner le mois : '); readln(mois); case mois of 12,1,2 : write('l''Hiver'); 3..5 : write('Le printemps'); 6..8 : write('L''été'); 9..11 : write('L''automne'); else writeln('Numéro mois eroné'); end; {du case} end. Index Application 11 {Paye de la semaine} {calcul de la paye d'un ouvrier et création d'un type énuméré jours} {création d'un type interval jours_de_travail} {Version 2} program paye_semaine; uses wincrt; Type jours = (dimanche, lundi, mardi, mercredi, jeudi, vendredi, samedi); jours_de_travail = lundi..vendredi; t_horaire_semaine = array[jours_de_travail] of integer; var t : t_horaire_semaine; j : jours_de_travail; total :integer; ps,thp :real; begin writeLN('Précisez la valeur du taux horaire : '); readln(thp); for j:= lundi to vendredi do begin writeln('Entrez le nombre d''heure du jour ',ord(j),' : '); readln(t[j]); total:= t[j] + total; end; PS:= total * thp; write('La paye de la semaine est : ',PS:3:3, ' DT'); end. Index Application 12 {Type : Algorithme de recherche} {Parcours partiel d'un tableau} program recherche; uses wincrt; Type TC = array[1..50] of char; var C : TC; i : integer; v : char; existe_v : boolean; n : integer; begin writeln('Donner n : '); readln(n); for i:= 1 to n do begin writeln('Donner la case n° ',i,' : '); readln(C[i]); end; write('Saisir le caractère recherché : '); readln(v); existe_v:=false; i:=1; repeat if C[i]=v then existe_v:=true; until (existe_v) or (i=n); if existe_v then writeln(v,' existe dans C') else writeln(v,' n''existe pas dans C') end. Index Application 13 {Type : Algorithme arithmétique} {afficher le PGCD de 2 entiers, par la méthode des différences} Program pgcd_differences; Uses wincrt ; Var a, b : byte; begin write ('Donner a : '); readln (a); write ('Donner b : '); readln (b); while a <> b do if a > b then a := a - b else b := b - a ; write (' Le plus grand diviseur commun est: ',a) ; End. Index Application 14 Division sans DIV {Division entière de deux entiers sans avoir recour à la fonction prédéfinie DIV} program division2; uses wincrt; var r1, r2 :integer; i :integer; begin writeln('Donner 2 entiers : '); readln(r1,r2); i:=0; while r1>= r2 do begin r1:= r1-r2; i:=i+1; end; writeln ('la division est : ',i); end. Index Application 15 version 2 {Division réelle de deux entiers sans avoir recour à l'opérateur / précision 2 décimles} program division2; uses wincrt; var r1, r2 :integer; i,j,k :integer; begin writeln('Donner 2 entiers : '); readln(r1,r2); i:=0; j:=0; k:=0; while r1>= r2 do begin r1:= r1-r2; i:=i+1; end; if r1 <>0 then begin r1:=r1*10; while r1>= r2 do begin r1:= r1-r2; j:=j+1; end; if r1 <>0 then begin r1:=r1*10; while r1>= r2 do begin r1:= r1-r2; k:=k+1; end; end; end; writeln ('la division est : ',i,',',j,k); end. Index Application 16 program pas; uses wincrt; var i,c,n:byte; begin { } n := 1 + Round ((9 - 1) / 2); for i := 1 to n do begin c := i * 2 - 1; write (c:5); end; {} { c := 1; while c <= 9 do begin write (c:5); c:= c + 2; end; } end. Index Application 17 Approximation {Chapitre IV - Structures itératives } {Type : Les algorithmes d'approximations} {chercher une valeur approchée de x0 où f(x) admet un minimum} Program recherche_x0; uses wincrt; var pas,x,fx,x0,fx0:real; begin write('Donner le pas d''avancement de x : '); readln(pas); x:=pas; {x vari entre 0 + pas et 4} x0 :=x; {hypothèse} fx0:=x0+1+(1/x0); repeat x:=x + pas; fx:=x+1+(1/X); if fx<fx0 then begin fx0:=fx; x0:=x; end; until (x>4) or (fx>fx0); writeln('f(x) = x+1+1/x admet un minimum en x0 '); writeln('x0 est encadré entre ',x0:3:4,' et ',x:3:4); end. Index Application 18 Combinaison {Ecrire un programme qui détermine puis affiche le nombre de combinaisons de p objets parmi n, n et p sont deux entiers naturels strictement positifs (n >= p). } Program Combinaison ; uses wincrt; Var f1, f2, f3 ,p , n : integer ; c : integer ; Function fact (x: integer) : integer ; var f,c :integer; Begin f:=1; For c :=1 to x Do begin f:= f * c; End; Fact:=f; End ; procedure saisie(var n,p:integer); begin Repeat Writeln('donner un entire n '); readln(n) ; Writeln('donner un entire p'); readln(p) ; until (n>=p) and ( p>0); end; Begin {pp} Writeln('********** Nombre de combinaison ***********'); saisie(n,p); f1:=fact(n); f2 :=fact(p) ; f3 :=fact(n-p) ; c :=f1 div(f2 *f3); writeln ('la combinaison de p objets parmi n est = ', c); End. Index Application 19 pos_min program minimum; uses wincrt; type tab=array[1..20]of integer; var T:tab; i,n :integer; function pos_min (T:tab; n:integer):integer; var pm:integer; begin pm:=1; for i:=2 to n do if T[i]<T[pm] then pm:=i; pos_min:=pm; end; begin repeat writeln('Donner un entier n compris entre 1 et 20'); readln(n); until (n>=1) and (n<=20); for i:=1 to n do begin T[i]:=random(51); writeln('case ',i,' : ',T[i]); end; writeln('La positon du min est ',pos_min(T,n)); end. Index Application 20 Nombre de lettre & chiffre dans T {Chapitre 5 - les sous programmes} {activité 2 livre page 175} {découpage d'un programme en procédures paramétrées } program calcul_caracteres; uses wincrt; type tab_c=array[1..20]of char; var T :tab_c; n,L,C :integer; procedure saisie(var n:integer); begin repeat Write('Donne la taille du tableau :'); readln(n); until (n<=20) and (n>=2); end; { ** } procedure remplir(var T:Tab_c; n:integer); var i:integer; begin for i:=1 uploads/Litterature/ exercice-corrige-pascal.pdf