Пример может пригодиться для иллюстрации задачи сортировки массивов. Картинка сдвигается всё время вправо, независимо сортируя цифры в каждой из 24 занятых строк консоли. Когда сортировка всех строк на экране заканчивается, её направление меняется на противоположное (с возрастания на убывание и обратно) и процесс повторяется. Выход из программы по клавише ESC.

А вот полный текст программки:

uses crt;

var n:array [1..24,1..40] of integer;
    dir:integer;

procedure init;
var i,j:integer;
begin
 randomize;
 for i:=1 to 24 do
 for j:=1 to 40 do
  n[i,j]:=random(10);
 dir:=1;
end;

procedure swap (var a,b:integer);
var c:integer;
begin
 c:=a; a:=b; b:=c;
end;

procedure print;
var i,j:integer;
begin
 clrscr;
 for i:=1 to 24 do begin
  if dir=1 then textcolor (Lightgray) else textcolor (red);
  for j:=1 to 39 do begin
   if (dir=1) and (n[i,j]>n[i,j+1]) or
      (dir=-1) and (n[i,j]<n[i,j+1]) then begin
      if dir=1 then textcolor (red)
      else textcolor (Lightgray);
   end;
   write (n[i,j]:2);
  end;
  write (' ',n[i,40]);
 end;
end;

procedure scr (j:integer);
var i,k,cnt:integer;
begin
 cnt:=0;
 for i:=1 to 24 do begin
   for k:=j+1 to 40 do
    if dir=1 then begin
     if n[i,j]>n[i,k] then swap(n[i,j],n[i,k])
     else inc(cnt);
    end
    else begin
     if n[i,j]<n[i,k] then swap(n[i,j],n[i,k])
     else inc(cnt);
    end;
 end;
 if cnt=0 then
  dir:=-dir; {n*n/2-n comparations}
end;

var j:integer;
    ch:char;
begin
 init;
 j:=1;
 repeat
  repeat
   delay (10000);
   scr (j);
   print;
   if j<40 then inc(j)
   else j:=1;
  until keypressed;
  write ('ESC to EXIT');
  ch:=readkey;
 until ch=#27;
end.

 Простые алгоритмы сортировки одномерного массива

гостевая; E-mail