program Dz;
uses crt;
const t='SORTIROV.txt';
var f: file of real;
s:real;min:real;
procedure out_fil;
var a:array [1..20] of real;
i, j:integer; s1:string;
 
   begin
               assign(F,t);
 
               i:=1;
               repeat
                     writeln ('Введите число или * (признак конца ввода)');
                     readln (s1);
                     val(s1,s,j);
                            if s1<>'*' then
                                                begin
                                                     a[i]:=s;
                                                     i:=i+1;
                                                end;
               until s1='*';
               rewrite(f);
                for j:=1 to i-1 do
                              write (F,a[j]);
 
               close(f);
          end;
{--------------------------------------------------------------}
procedure input_fil;
          begin
               assign (f,t);
               reset(f);
               read (f,s);
               min:=s;
               repeat
                     read (f,s);
                     if s< min then min:=s;
                     writeln (s:4:2,'  ');
               until EOF(f);
               close(f);
          end;
{----------------------------------------}
begin
clrscr;
gotoxy (15,8);
writeln ('Программу разработал Grief');
gotoxy (10,10);
{out_fil;}
writeln ('Чтение из файла');
clrscr;
input_fil;
writeln('min= ', min:4:0);
gotoxy (10,20);
writeln('Нажмите любую клавишу');
readln;
end.

Type
  arrType = Array[1 .. n] Of Integer;

{ первый вариант : }
Procedure HoarFirst(Var ar: arrType; n: integer);

  Procedure sort(m, l: Integer);
  Var i, j, x, w: Integer;
  Begin

    i := m; j := l;
    x := ar[(m+l) div 2];
    Repeat

      While ar[i] < x Do Inc(i);
      While ar[j] > x Do Dec(j);
      If i <= j Then Begin
        w := ar[i]; ar[i] := ar[j]; ar[j] := w;
        Inc(i); Dec(j)
      End

    Until i > j;
    If m < j Then Sort(m, j);
    If i < l Then Sort(i, l)

  End;

Begin
  sort(1, n)
End;

Цитата(Unconnected @ 25.05.2010 16:33)

Type
  arrType = Array[1 .. n] Of Integer;

{ первый вариант : }
Procedure HoarFirst(Var ar: arrType; n: integer);

  Procedure sort(m, l: Integer);
  Var i, j, x, w: Integer;
  Begin

    i := m; j := l;
    x := ar[(m+l) div 2];
    Repeat

      While ar[i] < x Do Inc(i);
      While ar[j] > x Do Dec(j);
      If i <= j Then Begin
        w := ar[i]; ar[i] := ar[j]; ar[j] := w;
        Inc(i); Dec(j)
      End

    Until i > j;
    If m < j Then Sort(m, j);
    If i < l Then Sort(i, l)

  End;

Begin
  sort(1, n)
End;

Program puzirek;
uses crt;
var
a: array [1..10] of integer;
i,j,c: integer;
procedure vvod;
begin
writeln('vvedite massiv');
for i:=1 to 10 do
readln (a[i]);
end;
procedure osn_puz;
begin
for i:=1 to 9 do
 begin
  for j:=i+1 to 10 do
   begin
    if (a[j]>a[i]) then
    begin
    c:=a[j];
    a[j]:=a[i];
    a[i]:=c;
    end;
   end;
  end;
 end;
procedure vyvod;
begin
writeln('rezultat');
for i:=1 to 10 do
writeln(a[i]);
end;
begin
clrscr;
vvod;
osn_puz;
vyvod;
readkey;
end.