programkaprekar ;

useswincrt;

var

k,r : longint ;

test : boolean ;

procedureoperation( var r: longint; k: longint) ;

var

n, nd, rk, ng , l: Longint;

e:integer;

ch ,chg: string ;

begin

str( k , ch);

n:=length(ch);

rk:= sqr(k);

str(rk,ch) ;

l:=length(ch);

chg:= copy(ch,1,l-n);

delete(ch,1,l-n );

val(ch , nd , e ) ;

val(chg , ng , e ) ;

r:= nd + ng;

end;

procedureverif( var test : boolean ; r,k: longint );

begin

test := (r = k);

end;

begin

for k := 1 to 1000 do

begin

operation( r , k );

verif( test , r , k );

if test then writeln( k );

end;

end.

program poids;

useswincrt;

Var

ch:string;

procedure saisie (var ch:string);

var

i:integer;

ch1:string;

begin

repeat

writeln('entrer une chaine Majuscule non vide :');

readln(ch);

ch1:='';

for i:= 1 to length(ch) do

if(ch[i] in ['A'..'Z']) then ch1:=ch1+ch[i];

until(ch>'') and (ch=ch1);

end;

function rang(c:char):integer;

var

r:integer;

begin

case c of

'A': r:=1;

'E': r:=5;

'I': r:=9;

'O': r:=15;

'U': r:=21;

'Y': r:=25;

end;

rang:=r;

end;

functionpoid(ch:string):integer;

var

p,i:integer;

begin

p:=0;

for i:=1 to length(ch) do

if (ch[i] in ['A','E','I','O','U','Y'])then p:=p+(i*rang(ch[i]));

poid:=p;

end;

Begin

saisie(ch);

writeln('le poid = : ', poid(ch));

End.

program insert;

useswincrt;

type

tab=array[1..11] of integer;

var

t:tab;

n,e:integer;

procedure remplir (var t:tab; var n:integer);

var

i:integer;

begin

repeat

writeln('donner la taille du tableau entre 4 et 10');

readln (n)

until n in [4..10];

writeln ('donner le premier elementT[1]=');

readln(t[1]);

for i:= 2 to n do

repeat

writeln('donner l''element T[',i,']=');

readln(t[i])

until (T[i] > t[i-1]);

end;

procedure insertion (var E:integer; var t:tab; n:integer);

var

i:integer;

begin

i:=n;

writeln('donner l''element à inserer');

readln(E);

while (t[i] >E) and (i>=1) do

begin

t[i+1]:= t[i];

i:= i-1;

end;

t[i+1]:=E;

end;

procedure affiche (t:tab;n:integer);

var

i: integer;

begin

for i:= 1 to n+1 do

write(t[i],' | ');

end;

begin

remplir(t,n);

insertion (e,t,n);

affiche (t,n);

end.

infoatlps.jimdo.com / 1