Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 09.12.2010, 00:26   #1
melkaya9112
Новичок
Джуниор
 
Регистрация: 09.12.2010
Сообщений: 8
По умолчанию нужно исправить код

Код:
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.

Последний раз редактировалось Вадим Мошев; 29.04.2015 в 01:35.
melkaya9112 вне форума
Старый 09.12.2010, 00:56   #2
ACE Valery
Сама себе режиссер
Старожил
 
Аватар для ACE Valery
 
Регистрация: 27.04.2007
Сообщений: 3,365
По умолчанию

Больше ничего не нужно?
Во-первых, код надо оформлять тегом [code]
Во-вторых, надо писать условие задачи и возникающие ошибки.
В-третьих, тон слегка поубавить - вам здесь не рабы сидят. Слово "пожалуйста" вам знакомо?

Подумайте над своим поведением.
Закрываю.
В следующей теме учтите мои замечания
Если я вас напрягаю или раздражаю, вы всегда можете забиться в угол и поплакать
ACE Valery вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
нужно исправить код Alt_Shift Общие вопросы C/C++ 4 14.11.2010 16:16
[C++ масиви] Нужно исправить код basav1k Помощь студентам 1 02.06.2010 22:21
нужно исправить готовый код Алексей Долгов Помощь студентам 2 02.06.2010 15:46
[C++ масиви] Нужно исправить код loloverg Общие вопросы C/C++ 1 01.06.2010 19:16
C++. Есть код нужно исправить ошибки megavolt91 Общие вопросы C/C++ 6 06.06.2009 19:27