Niveau_en_gris

program ex;
uses wincrt;

Type
mat= array[1..10,1..6] of string;

Var
ft:text;
l,c:integer;
m:mat;


function hextodec(a:string):integer ;
Var
b,d,i:integer;
Begin
b :=1;
d:=0;
for i := Length(a) DownTo 1 Do
Begin
if a[i] in ['0'..'9'] Then
Begin
d := d + ((ord(a[i]) - 48)*b) ;
b := b*16;
end
Else
Begin
d := d + ((ord(a[i]) - 55)*b);
b := b*16;
end;
end;
hextodec := d;
end;

function dectohex(a:integer):string;
Var
ch:string;
i,r:integer;
Begin
ch:='';
i:=0;
while a <> 0 Do
Begin
r := a mod 16;
if r < 10 Then
Begin
ch := chr(ord(r)+48)+ch;
end
Else
Begin
ch := chr(ord(r)+55)+ch;
end;
a := a div 16;
end;
dectohex:=ch;
end;

function conv(ch:string):string;
Var
r,v,b,y:integer;
Begin
r:=hextodec(copy(ch,1,2));
v:=hextodec(copy(ch,3,2));
b:=hextodec(copy(ch,5,2));
y:=trunc(0.299*r + 0.587*v + 0.114*b);
conv := dectohex(y);
end;

procedure remplir(var ft:text;var m:mat;var l,c:integer);
Var
i,j,e:integer;
ch:string;
k:char;
Begin
reset(ft);
readln(ft,k);
val(k,l,e);
readln(ft,k);
val(k,c,e);
for i := 1 to l Do
Begin
for j := 1 to c Do
Begin
readln(ft,ch);
m[i,j]:=ch;
end;
end;
close(ft);
end;


procedure transfert(var m:mat;l,c:integer);
Var
i,j:integer;
x:string;
begin
for i := 1 to l Do
Begin
for j := 1 to c Do
Begin

x := conv(m[i,j]);
m[i,j]:=x;
end;
writeln;
end;
end;


procedure afficher(m:mat;l,c:integer);
Var
i,j:integer;
Begin
for i := 1 to l Do
Begin
for j := 1 to c Do
Begin
write(m[i,j],'  ');
end;
writeln;
end;
end;

Begin
assign(ft,'D:\image.txt');
remplir(ft,m,l,c);
afficher(m,l,c);
transfert(m,l,c);
afficher(m,l,c);
end.