Programe Pascal

1

Programe simple in Pascal

1.Realizati un program care sa afiseze a “k”-a cifra a unui numar citit “n”.

Program1 program A_k_cifra_a_lui_n; var n,k,p,cifra:integer; procedure afiseaza_cifra(n,k,p,cifra:integer); begin p:=1; while p<=k-1 do begin n:=n div 10; p:=p+1; end; cifra:=n mod 10; writeln('cifra e:',cifra); end; begin writeln('DATI PE N=');readln(n); writeln('DATI PE K=');readln(k); afiseaza_cifra(n,k,p,cifra); end.

Program2 {scrieti un program care converteste un nr in baza 2, rezultatul fiind un sir de car format din 0 si 1} program ConversieInBinar; var n:integer; s:string; function conversie(n:integer):string; var s:string; c:integer; begin s:=''; while n<>0 do begin c:=n mod 2; if c=0 then s:='0'+s else s:='1'+s; n:=n div 2 end; conversie:=s;end; begin writeln('numarul este:');readln(n); s:=conversie(n); writeln('asa arata numarul in binar:',s); end.

2

Program3 :cmmdc,cmmmc,prim program cmmdc_cmmmc_prim; var n1,n2:integer; function cmmdc(n1,n2:integer):integer; begin while n1<>n2 do if n1>n2 then n1:=n1-n2 else n2:=n2-n1; cmmdc:=n1; end; function cmmmc(n1,n2:integer):integer; begin cmmmc:=n1*n2 div cmmdc(n1,n2); end; begin write('PRIMUL NUMAR N1:');readln(n1); write('AL DOILEA NUMAR,N2:');readln(n2); writeln('CEL MAI MARE DIVIZOR COMUN ESTE:'); writeln(cmmdc(n1,n2)); WRITELN('CEL MAI MIC MULTIPLU COMUN ESTE:'); writeln(cmmmc(n1,n2)); if cmmdc(n1,n2)=1 then writeln('NUMERELE SUNT PRIME INTRE ELE') else writeln('NUMERELE NU SUNT PRIME INTRE ELE'); end.

Program4: program InversareCifre; var n,inv,rez:integer; function invers(nr,nrinv:integer):integer; var i:integer; begin nrinv:=0; repeat nrinv:=nrinv*10+(nr mod 10); nr:=nr div 10; until nr=0; invers:=nrinv; end; begin writeln('PROGRAM CE CALCULEZA INVERSUL UNUI NUMAR'); write('numarul este:');readln(n); rez:=invers(n,inv); writeln('INVERSUL ESTE:',rez); end.

Program5: {scrieti o functie care sa inverseze un sir de caractere.In cadrul functiei

3 se va folosi doar operatia de concatenare de stringuri si o var auxiliara de tip string} program InversareSir; var s,sir:string; {n,i:integer;} function inversare(s:string):string; var n,i:integer; sir:string; begin sir:=''; for i:=length(s) downto 1 do if s[i]<>' ' then sir:=sir+s[i]; inversare:=sir; end; begin writeln('INTRODUCETI SIRUL:');readln(s); sir:=inversare(s); writeln('SIRUL INVERSAT ESTE:',sir); end.

Program6:Sa se creeze o lista simplu inlantuita care sa stocheze medicamente program depozit2; {merge} {DECLARARE TIPURI DE DATE} type medicament=record denumire:string; cod,pret:longint; end; depozit=^nod; nod=record m:medicament; urm:depozit; end; {DECLARARE VARIABILE} var d:depozit; med:medicament; c:char; {DECLARARE PROCEDURI} {1.PROCEDURA DE INITIALIZARE} procedure initializare(var p:depozit) ; begin p:=nil;end; {FUNCTIA VIDA} function vida(p:depozit):boolean; begin vida:=p=nil;end; {PROCEDURA DE ADAUGARE DE NODURI IN LISTA} procedure adaugare(m:medicament;var p:depozit); var q,r:depozit; begin new(q);q^.m:=m; if vida(p) then begin q^.urm:=nil; p:=q;

4 end else begin r:=p; while (r^.urm<>nil) do r:=r^.urm; q^.urm:=r^.urm; r^.urm:=q;end; end; {PROCEDURA DE STERGERE} procedure stergere(m:medicament;var p:depozit); var q,r:depozit; begin if not vida(p) then if p^.m.denumire=m.denumire then begin q:=p; p:=p^.urm; end else begin r:=p; while (r^.urm<>nil) and (r^.urm^.m.denumire<>m.denumire) do r:=r^.urm; if r^.urm<>nil then begin q:=r^.urm; r^.urm:=q^.urm;end;end; dispose(q); end; {PROCEDURA DE AFISARE} procedure afisare(p:depozit); var q:depozit; begin q:=p; repeat writeln(q^.m.denumire,' ',q^.m.cod,' ',q^.m.pret); q:=q^.urm; until q=nil; end; {PROGRAM PRINCIPAL} begin initializare(d); repeat writeln('a-adaugare');writeln('l-listare');writeln('s-stergere'); writeln('o-iesire'); write('OPTIUNEA ALEASA:'); readln(c); case c of 'a':begin writeln('INFORMATII MEDICAMENT:'); write('NUME=');READLN(MED.DENUMIRE); write('COD=');readln(med.cod); write('PRET=');readln(med.pret); adaugare(med,d); end; 's':begin write('CE MEDICAMENT VREI SA STERGI?');readln(med.denumire); stergere(med,d);end; 'l':afisare(d); end; until c='o'; readln;end.

5

Program7: program zodii; {MERGEEEEEEEEEEEEEEEEEEEEE} {DECLARARE TIPURI DE DATE} TYPE persoana=record {inregistrare de tip persoana} nume,zodia:string; {numele si zodia persoanei} zi,luna:byte;end; lista=^nod; {lista in care depozitam persoanele} nod=record {nodul listei ce contine inreg de tip persoana si ad urm} p:persoana; {variabila de tip persoana} urm:lista; {adresa nodului urmator :)} end; {DECLARARE VARIABILE GLOBALE} var l:lista; {variabile globale folosite in pg principal} pers:persoana; c:char;contor:byte; {DECLARARE PROCEDURI SI FUNCTII} procedure initializare(var li:lista); begin li:=nil;end; function vida(li:lista):boolean; begin vida:=li=nil;end; procedure adaugare(p:persoana;var li:lista); var q,r:lista; begin new(q);q^.p:=p; if vida(li) then begin q^.urm:=nil; li:=q; end else begin r:=li; while r^.urm<>nil do r:=r^.urm; q^.urm:=r^.urm; r^.urm:=q; end; end; {PROCEDURA ZODIE} procedure stabilire_zodie(var p:persoana; var li:lista); var q:lista; begin q:=li; while q<>nil do begin if (((q^.p.luna=11) and (q^.p.zi<=21)) or ((q^.p.luna=10) and ((q^.p.zi>23))) )then q^.p.zodia:='scorpion' else q^.p.zodia:='altceva'; q:=q^.urm; end; end; procedure numara(var p:persoana;var li:lista); var q:lista; contor,cont1:byte; begin q:=li;contor:=0; while q<>nil do begin if q^.p.zodia='scorpion' then contor:=contor+1; q:=q^.urm;end; cont1:=contor;writeln('s-au gasit atatia:',cont1); end; {PROCEDURA DE AFISARE}

6 procedure afisare(li:lista); var q:lista; begin q:=li; repeat writeln( q^.p.nume, ' ',q^.p.zi,' ',q^.p.luna); q:=q^.urm; until q=nil; end; procedure afisare1(li:lista); var q:lista; begin q:=li; repeat writeln( q^.p.nume, ' ',q^.p.zi,' ',q^.p.luna,q^.p.zodia); q:=q^.urm; until q=nil; end; {PROGRAM PRINCIPAL} begin initializare(l); repeat writeln('a-adaugare');writeln('l-listare');writeln('e-iesire'); writeln('z-zodie');writeln('c-contor zodii'); write('OPTIUNEA ALEASA'); readln(c); case c of 'a':begin writeln('INFORMATII PERSOANA'); write('NUME=') ;readln(pers.nume); write('ZI=');readln(pers.zi); write('LUNA=');readln(pers.luna); adaugare(pers,l); end; 'l':afisare(l); 'z': begin stabilire_zodie(pers,l); afisare1(l);end; 'c':begin numara(pers,l);end; end; until c='e';readln;end.

Program mai multe prime intre ele; program mai_multe_prime; type vector=array[1..10] of integer; var n,i,cmmdc:integer; v:vector; begin write('n=');readln(n); for i:=1 to n do begin writeln(' ',i,': '); readln(v[i]); end; for i:=1 to n-1 do begin while v[i]<>v[i+1] do begin if v[i]>v[i+1] then v[i]:=v[i]-v[i+1] else v[i+1]:=v[i+1]-v[i];end;

7 cmmdc:=v[i]; end; if cmmdc=1 then writeln('numerele sunt prime intre ele') else writeln('numerele nu sunt prime intre ele si cmmdc este:',cmmdc); end.

Program numar prim program numar_prim; var n,i:integer; prim:boolean; begin write('introduceti numarul:');readln(n); prim:=true; i:=2; while (i<=n/2) and prim do begin if n mod i=0 then prim:=false; i:=i+1; end; if prim=true then writeln('numarul este prim') else writeln('numarul nu este prim'); writeln; end.

Program palindrom program Palindromm; var n,inv,rez,pal:integer; function invers(nr,nrinv:integer):integer; var i:integer; begin nrinv:=0; repeat nrinv:=nrinv*10+(nr mod 10); nr:=nr div 10; until nr=0; invers:=nrinv; end; function palindrom(pal:integer):boolean; var nr,iinv:integer; begin nr:=pal; iinv:=0; while pal<>0 do begin iinv:=iinv*10+pal mod 10; pal:=pal div 10;end; palindrom:=nr=iinv;end; begin writeln('PROGRAM CE CALCULEZA INVERSUL UNUI NUMAR'); write('numarul este:');readln(n); rez:=invers(n,inv); writeln('INVERSUL ESTE:',rez); if palindrom(pal) then writeln('NUMARUL ESTE PALINDROM')

8 else writeln('NUMARUL NU ESTE PALINDROM'); end.