Пример может пригодиться для иллюстрации задачи сортировки массивов. Картинка сдвигается всё время вправо, независимо сортируя цифры в каждой из 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.

P.S. Писалось во времена окна консоли 80x25 и на каком=то старом Паскале, "не понимающем" нормальной задержки delay. Во Free Pascal, к примеру, следует заменить delay (10000); на что-то вроде delay (100);. Вот подобный код для Free Pascal, только сортирует на экране одну строку:

uses crt;

procedure print1 (var a:array of integer; i:integer;color:integer);
begin
 textcolor(color);
 gotoxy (1+i*2,1);
 write (a[i]:2);
end;

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

procedure init (var a:array of integer;color:integer);
var i,j:integer;
begin
 randomize;
 clrscr;
 for i:=low(a) to high(a) do begin
  a[i]:=random(10);
  print1(a,i,color);
 end;
end;

const LENGTH = 40;
var n: array of integer;
 cnt,i,j,color : integer;
 ch : char;
 dir : boolean;

begin
 dir:=true;
 setlength (n,LENGTH);
 color:=lightgray;
 init(n,color);
 repeat
  repeat
   cnt:=0;
   for i:=low(n) to high(n)-1 do begin
    for j:= i+1 to high(n) do begin
     if (dir) and (n[j]>n[i]) or
        (not dir) and (n[j]<n[i]) then begin
      swap(n[i],n[j]);
      if color=lightred then color:=lightgray
      else color:=lightred;
      print1 (n,i,color);
      print1 (n,j,color);
      inc(cnt);
     end;
     delay(10);
    end;
    if cnt=0 then begin
     dir := not dir;
     if color=lightred then color:=lightgray
     else color:=lightred;
    end;
   end;
  until keypressed;
  ch:=readkey;
 until ch=#27;
end.

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

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