Code:
const
fieldWidth = 10;
fieldHeight = 10;
field : Array[1..fieldWidth, 1..fieldHeight] of Integer = ((0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
type
TSolution = record
StartX, EndX : Integer;
StartY, EndY : Integer;
end;
function ValidRect(const AStartX, AStartY, AEndX, AEndY : Integer) : Boolean;
var
C1 : Integer;
begin
result := FALSE;
For C1 := AStartX to AEndX Do
If field[AStartY, C1] = 0 Then
Exit;
For C1 := AStartX to AEndX Do
If field[AEndY, C1] = 0 Then
Exit;
For C1 := AStartY to AEndY Do
If field[C1, AStartX] = 0 Then
Exit;
For C1 := AStartY to AEndY Do
If field[C1, AEndX] = 0 Then
Exit;
result := TRUE;
end;
function SolveField : TSolution;
var
C1, C2 : Integer;
C3, C4 : Integer;
begin
result.StartX := 0;
result.EndX := 0;
result.StartY := 0;
result.EndY := 0;
If (fieldHeight <= 1) or
(fieldWidth <= 1) Then
Exit;
For C1 := 1 to fieldHeight - 1 Do
For C2 := 1 to fieldWidth - 1 Do
If field[C1, C2] = 1 Then
For C3 := fieldHeight downto C1 + 1 Do
For C4 := fieldWidth downto C2 + 1 Do
If (field[C3, C4] = 1) and
((result.EndX - result.StartX + 1) * (result.EndY - result.StartY + 1) < (C4 - C2 + 1) * (C3 - C1 + 1)) and
(ValidRect(C2, C1, C4, C3)) Then
Begin
result.StartX := C2;
result.EndX := C4;
result.StartY := C1;
result.EndY := C3;
End;
end;
var
solution : TSolution;
begin
solution := SolveField;
end.
[Ovu poruku je menjao reiser dana 18.04.2006. u 16:06 GMT+1]