bac pratique 14h 2013

//http://kiteb.net/education/informatique/bac/bacinfo2013/bac-pratique-23052013-algo-14h.pdf
Program bac2013;
uses WinCrt;
type
     mat= Array [1..24,1..24] of Integer;
     eng= Record
      nl,icd,icf : Byte;
     end;
     tab = Array [1..24] of eng;
var
  m :mat ;
    l,c :byte;
    t: tab;
    f: text;
    Procedure saisi(var x : Byte;ch: string);
     begin
        repeat
            write(ch);
            readln(x);
        until  x in [3..24 ]
     end;
    Procedure rempM(var m : mat ; l,c: Byte);
     var
        a,b: Byte;
     begin
        for a:=1 to l do
         for b:=1 to c  Do
           begin
              repeat
                    write('M[',a,',',b,'] : ');
                    readln(m[a,b]);
                until m[a,b] <>0;
             end;
     end;
     Procedure init(var t : tab ; l : Byte);
      var
        a: Byte;
        begin
         for a:=1 to l do
          begin
             t[a].nl:=0;
             t[a].icd:=0;
             t[a].icf:=0;
            end;
        end;
     Procedure rempt(var t :tab; m: mat ;l,c: Byte);
        var
         a,b,d,s: Byte;
        begin
            init(t,l);
         for a:=1 to l do
            begin
                for d:=1 to  c do
                    begin
                        b:=d;
                        s:=0;
                        repeat
                            s:=s+m[a,b];
                            b:=b+1;
                        until (b>c ) or (s=0 );
                        if (s=0 ) then
                            if (t[a].icf - t[a].icd < (b) -d  ) then
                            begin
                                t[a].nl:=a;
                                t[a].icf:=b-1;
                                t[a].icd:=d;
                            end;
                    end;
            end;
        end;
        function calc(t : tab ; l : Byte): Byte;
            var
             a,max: Byte;
            begin
           max :=0;
             for a:=1 to l do
              if t[a].icf -t[a].icd > max then
                 max := t[a].icf -t[a].icd ;
                calc:=max;
            end;
      Procedure fillfile(var f : text ;t :tab; l : Byte);
            var
             a,max:Byte;
            begin
                rewrite(f);
                max:=calc(t,l);
                for a:=1 to l do
                    if t[a].icf -t[a].icd = max  then
                     writeln(f,t[a].nl,'#',t[a].icd,'#',t[a].icf);
                close(f);
            end;
begin

 saisi(l,'Nbr de ligne: ');
 saisi(c,'Nbr de colonnes:' );
 rempm(m,l,c);
    rempt(t,m,l,c);
assign(f,'C:\Users\platpot\Desktop\arfizato\progg\pascal\Projects\bac2013.txt');
 fillfile(f,t,l);
end.