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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 21.03.2011, 20:44   #1
Leshiy1
Форумчанин
 
Аватар для Leshiy1
 
Регистрация: 24.09.2009
Сообщений: 104
По умолчанию К-Т

Помогите задать траекторию(рисунок в файле) Нужно найти максимальный элемент матрицы и отсортировать заданную траекторию в матрице

Код:
Program Etape1;
uses crt;
const n=7; m=8;     {Razmeru matricu}
var  i,j,y,x,kt,xp,yp,b,xm,ym,max:integer;  {Rabochie peremennue}
     A:array[0..n-1,0..m-1]of Integer;          {Matrica}
{***********************************************************}
Begin
     ClrScr;     Randomize;   TextColor(4);
     {---------Vvod i pechat ish matricu ---------}
     For y:=0 to n-1 do
      begin
       For x:=0 to m-1 do
          begin A[y,x]:=random(100);  write(A[y,x]:3); end;
       Writeln;
      end;
 
    {------------------ Poisk max--------------- }
     ym:=0; xm:=0; max:=A[ym,xm];
     for y:=0 to n-1 do
      for x:=0 to m-1 do
        if max<A[y,x] then begin max:=A[y,x]; ym:=y; xm:=x; end;
 
     {--Opredelenie chisla elementov kt, prinadlezhashih traektorii---}
      if ym<xm Then kt:=2*ym+1
                        Else kt:=xm+ym+1;
 
         {------ Sortirovka puzurkom --------- }
    for i:=0 to kt-1 do    { Vneshniy cik
    l sortirovki}
      begin
       yp:=0;  xp:=xm; {xp,yp - Koordinatu predudushego elementa traektorii }
       for j:=0 to kt-2 do { Vnutrenniy cikl sortirovki}
        begin
               {Poluchenie koordinat х,у sleduushego el-ta traektorii}
         If j<ym
           then begin x:=xp;   y:=yp+1; end    {dvigenie po verticali}
           else begin x:=xp-1; y:=yp-1; end;   {dvigenie po diagonali}
         If A[y,x]<A[yp,xp]
           then {esli sleduushiy el-t menshe predudushego, to obmen }
            begin b:=A[y,x]; A[y,x]:=A[yp,xp]; A[yp,xp]:=b; end;
          xp:=x; yp:=y; {tek. koordinatu el-ta stanovyatsya predudushimi }
        end;
      end;
 
      {------------vuvod resultatov-------------- }
     writeln;
     writeln(' max=',max,' xm=',xm,' ym=',ym);
     writeln;
     For i:=0 to n-1 do
      begin
       For j:=0 to m-1 do write(A[i,j]:3);
       Writeln;
      end;
 
      {------------- raskraska traektorii---------- }
     yp:=0;  xp:=xm; TextColor(10);
     for j:=0 to kt-1 do  begin
         GotoXY ( 3*(xp)+1, n+yp+4 );
         Write(A[yp,xp]:3);
         If j<ym  {poluchenie koordinat х,у sleduushego  el-ta traektorii}
           then begin x:=xp;   y:=yp+1; end    {dvigenie po verticali}
           else begin x:=xp-1; y:=yp-1; end;   {dvigenie po gorizontaly}
         xp:=x; yp:=y;
     End;
     TextColor(7);
     Readkey;
End.
Изображения
Тип файла: jpg Безымянный.JPG (5.1 Кб, 118 просмотров)
Leshiy1 вне форума Ответить с цитированием
Ответ


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