Informatika gyűjtemény

Egy szinttel feljebb ep_parc.pas

2004050607080910

NézetNyomtat

ep_parc.pas (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 2 KB
program parcella;
const fnum = '9';
type mezo = Record x,y   : integer end;
     parc = Record ba,jf : mezo end; 

var vdb   : word;
    vagas : array[1..1000] of mezo;
    pdb   : word;
    ptomb : array[1..3001] of parc;
    max   : longint;

procedure beolvas;
var be  : Text;
    i,: word;
begin
    assign(be,'parcellak'+fnum+'.be');
    reset(be);
    readln(be,i,j,vdb);
    pdb := 1;
    ptomb[1].ba.:= 1;
    ptomb[1].ba.:= 1;
    ptomb[1].jf.:= i;
    ptomb[1].jf.:= j;
    for i := 1 to vdb do readln(be,vagas[i].x,vagas[i].y);
    close(be);
end;

function pkeres(x,y:word):word;
var i : word;
begin
    for i := 1 to pdb do
    if  (ptomb[i].ba.x<=x) and (ptomb[i].jf.x>=x) and
        (ptomb[i].ba.y<=y) and (ptomb[i].jf.y>=y)
    then begin
        pkeres := i;
        break;
    end;
end;

procedure ptorol(p:word);
begin
    ptomb[p] := ptomb[pdb];
    dec(pdb);    
end;

procedure pbeszur(np:parc);
begin
    inc(pdb);
    ptomb[pdb] := np;
end;

procedure vag(index: word);
var p,x1,x2,y1,y2 : word;
    x,: word;
    np : parc;
begin
    x := vagas[index].x;
    y := vagas[index].y;
    
    p := pkeres(x,y);
    x1 := ptomb[p].ba.x;
    y1 := ptomb[p].ba.y;
    x2 := ptomb[p].jf.x;
    y2 := ptomb[p].jf.y;
    ptorol(p);
    
    np.ba.:= x1;
    np.ba.:= y1;
    np.jf.:= x-1; 
    np.jf.:= y-1;
    if (np.ba.<= np.jf.x) and (np.ba.<= np.jf.y) then pbeszur(np);

    np.ba.:= x1;
    np.ba.:= y+1;
    np.jf.:= x-1; 
    np.jf.:= y2;
    if (np.ba.<= np.jf.x) and (np.ba.<= np.jf.y) then pbeszur(np);

    np.ba.:= x+1;
    np.ba.:= y1;
    np.jf.:= x2; 
    np.jf.:= y-1;
    if (np.ba.<= np.jf.x) and (np.ba.<= np.jf.y) then pbeszur(np);

    np.ba.:= x+1;
    np.ba.:= y+1;
    np.jf.:= x2; 
    np.jf.:= y2;
    if (np.ba.<= np.jf.x) and (np.ba.<= np.jf.y) then pbeszur(np);
        
end;

function terulet(: parc):longint;
begin
    terulet := (p.jf.- p.ba.+ 1)*(p.jf.- p.ba.+ 1);
end;

function maxkeres:longint;
var i,mi : word;
    t    : longint;
    m    : longint;
begin
    m  := terulet(ptomb[1]);
    mi := 1;
    for i := 2 to pdb do
    begin
    t := terulet(ptomb[i]);
    if > m  then
    begin
        mi := i;
        m := t;
    end;
    end;
    maxkeres := m;  
end;

procedure szamol;
var i : word;
begin
    for i := 1 to vdb do vag(i);
    max := maxkeres;
end;

procedure kiir;
begin
    writeln(max);
end;

begin
    beolvas;
    szamol;
    kiir;
end.
(Vissza)