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