Код:
l,w,mc,pc,sc,p: integer; //l - длина, w - шиина, mc - счетчик массива поля, pc - счетчик массива крайних точек
map,pts: array[0..1000] of TPoint; //map - массив поля, pts - массив крайних точек
sq,sqmax: array[0..1000] of integer;
implementation
function TForm1.findPoint(x, y: integer): integer;
var
i,r:integer;
begin
r := -1;
for i:=0 to mc do begin
if(map[i].X=x) and (map[i].Y=y) then begin
r := i;
break;
end;
end;
findPoint := r;
end;
function TForm1.getSq(p1, p2, p3, p4: TPoint): integer;
var
lb,lt: TPoint;
a,b:integer;
begin
if(p1.X<=p3.X) then begin
lb:=p1;
lt.X:=p1.X; lt.Y:=p3.Y;
end
else if (p3.X<=p1.X) then begin
lb.X:=p3.X; lb.Y:=p1.Y;
lt:=p3;
end;
a := lt.Y-lb.Y;
b := w;
getSq := a*b;
end;
function TForm1.getSq2(p1, p2, p3, p4: TPoint): integer;
var
lb,rb: TPoint;
a,b:integer;
begin
if(p1.X<=p3.X) then begin
lb:=p1;
end
else if (p3.X<p1.X) then begin
lb.X:=p3.X; lb.Y:=p1.Y;
end;
if(p2.X>=p4.X) then
rb:=p2
else if(p2.X<p4.X) then begin
rb.X:=p4.X; rb.Y:=p2.Y;
end;
a := l;
getSq2 := a*b;
end;
procedure TForm1.sortSqMax ;
var
a,i,j: integer;
begin
for i:=0 to sc do begin
for j:=0 to sc do begin
if(sqmax[i]>sqmax[j]) then begin
a:=sqmax[i];
sqmax[i]:=sqmax[j];
sqmax[j]:=a;
end;
end;
end;
end;
function TForm1.getMaxSq :integer;
var
i,j: integer;
begin
sqmax := sq;
sortSqMax;
for i:=0 to sc do begin
if(sq[i]=sqmax[0]) then begin
getMaxSq:=sq[i];
ListBox1.Canvas.TextOut(10,10,'max=' +inttostr(sq[i]));
if(i<p) then begin
ListBox1.Canvas.Rectangle(0,map[pts.x],w, map[pts[i+1].X]; {max.X0 := 0;
max.Y0 := map[pts[i].X].Y;
max.X1 := w;
max.Y1 := map[pts[i+1].X].Y;}
end else begin
ListBox1.Canvas.Rectangle(map[pts[i].X],0,map[pts[i+1].X],l);
end;
break;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i,j,k:integer;
begin
//вывод контрольных точек по углам области
with ListBox1, Canvas do
begin pen.Width:=10;
pen.color:= clyellow;
end;
listbox1.canvas.pixels[0,0];
listbox1.canvas.pixels[l,w];
listbox1.canvas.pixels[0,w];
listbox1.canvas.pixels[l,0];
//вывод точек из файла
for i:=0 to mc do begin //рисуем деревья
with ListBox1, Canvas do
begin
pen.color:= clBlack;
end;
listbox1.canvas.pixels[map[i].X,map[i].Y];
end;
//выполняем расчет наибольшего
//i - высота, j - ширина от 0 до w, k - ширина от w до 0
for i:=0 to l do begin
for j:=0 to w do begin
if(findPoint(j,i) <> -1) then begin //нашли точку от левого края
with ListBox1, Canvas do
begin pen.Width:=10;
pen.color:= clblack;
end;
Listbox1.canvas.Pixels[map[findPoint(j,i)].X,map[findPoint(j,i)].Y];
pts[pc].X := findPoint(j,i);
break;
end;
end;
for k:=w downto 0 do begin
if(findPoint(k,i) <> -1) then begin //нашли точку от левого края
with ListBox1, Canvas do
begin pen.Width:=10;
pen.color:= clyellow;
end;
ListBox1.Canvas.Pixels[[findPoint(k,i)].X,map[findPoint(k,i).Y]];
pts[pc].Y := findPoint(k,i);
break;
end;
end;
if((pts[pc].X <> 0) and (pts[pc].Y <> 0) and (i>0)) or (((pts[pc].X=0) or (pts[pc].Y=0)) and (i=0)) then
pc := pc+1;
p := pc;
pc := pc-1;
//трассировка крайних точек (снизу вверх)
for i:=1 to pc do begin
sq[sc] := getSq(map[pts[i-1].X],map[pts[i-1].Y],map[pts[i].X],map[pts[i].Y]);
sc := sc+1;
end;
//выполняем расчет наибольшего
//определяем слева направо линии параллельные оси Y
//i - ширина, j - высота от 0 до l, k - ширина от l до 0
for i:=0 to w do begin
for j:=0 to l do begin
if(findPoint(i,j) <> -1) then begin //нашли точку от левого края
with ListBox1, Canvas do
begin pen.Width:=10;
pen.color:= clyellow;
end;
listbox1.canvas.pixels[map[findPoint(i,j)].X,map[findPoint(i,j)].Y];
pts[pc].X := findPoint(i,j);
break;
end;
end;
for k:=l downto 0 do begin
if(findPoint(i,k) <> -1) then begin //нашли точку от левого края
with ListBox1, Canvas do
begin pen.Width:=10;
pen.color:= clyellow;
end;
listbox1.canvas.pixels[map[findPoint(i,k)].X,map[findPoint(i,k)].Y];
pts[pc].Y := findPoint(i,k);
break;
end;
end;
if((pts[pc].X <> 0) and (pts[pc].Y <> 0) and (i>0)) or (((pts[pc].X=0) or (pts[pc].Y=0)) and (i=0)) then
pc := pc+1;
end;
pc := pc-1;
//трассировка крайних точек (слева направо)
for i:=p to pc do begin
sq[sc] := getSq2(map[pts[i-1].X],map[pts[i-1].Y],map[pts[i].X],map[pts[i].Y]);
sc := sc+1;
end;
memo1.Lines.Add('');
memo1.Lines.Add('Максимальная площадь: '+inttostr(getMaxSq));
end;
end.