[@litvin]

В общем задали задачку, вроде простая, а решить не могу:)Гугл тоже помоч не может, поэтому жду помощи здесь. И так вот она:

Каждый элемент исходного массива представляет собой запись содержащую поля:
-фамилия сотрудника
-номер отдела
-величина оклада сотрудника
Сделать программу, которая по запросу упорядочивает данный массив по алфавиту(по фамилии).

С меня спасибка и автомаксимум за любую помощь.

[@Kavil]

Лучше сделать через record.
Вот к твоей задаче

program sotrudnik;
uses crt;
Type stud=Record
 Fio:String[15];
 otdel: 1..1000;
 oklad: 1..1000;
 End;
Var Fstud: File of Stud;
a:array[1..10] of integer;
n,i:integer;
s,g:stud;
begin
clrscr;
assign(Fstud, 'C:\file.dat');
reset(Fstud);
writeln('Vvedite kolvo sotrudnikov');
readln(n);
 for i:=1 to n do
 begin
 writeln('Vvedite fio sotrudnika');
 readln(s.FIO);
 writeln('Nomer otdela:');
 readln(s.otdel);
 writeln('Velechina oklada:');
 readln(s.oklad);
 write(Fstud,s);
end;
 close(fstud);
 reset(Fstud);
 readln;
 End.

Вот сдесь различные методы сортировки
http://valera.asf.ru/delphi/struct/sortir.html

Есть как буквы по адфавиту так и слова к примеру исходник сортировки мыл:

program MlistSort;
  type
    address = record
      name: string[30];
      street: string[40];
      sity: string[20];
      state: string[2];
      zip: string[9];
    end;
    str80 = string[80];
    DataItem = address;
    DataArray = array [1..80] of DataItem
    recfil = file of DataItem;

  var
    test: DataItem;
    t, t2:integer;
    testfile: recfil;

function Find(var fp:recfil; i:integer): str80
  var
    t:address;
begin
  i := i-1;
  Seek(fp, i)
  Read(fp, t)
  Find := t.name;
end;

procedure QsRand(var var fp:recfil; count:integer)
  procedure Qs(l, r:integer)
    var
      i, j, s:integer ;
      x, y, z:DataItem;
begin
  i := l; j := r;
  s := (l+r) div 2;
  Seek(fp,s-1);
  Read(fp,x);
  repeat
    while Find(fp, i) < x.name do i := i+1;
    while x.name < Find(fp, j) do j := j-1;
    if i<=j then
      begin
        Seek(fp,i-1);  Read(fp,y);
        Seek(fp,j-1);  Read(fp,z);
        Seek(fp,j-1);  Write(fp,y);
        Seek(fp,i-1);  Write(fp,z);
        i := i+1; j := j-1;
      end;
    until i>y;
    if l<j then qs(l, j)
    if l<r then qs(i, r)
end;
begin
  qs(1,count);
end;
begin
  Assign(testfile, 'C:\file.dat');
  Reset(testfile);
  t := 1;
  while not EOF(testfile) do begin
    Read(testfile,test);
    t := t+1;
  end;
  t := t-1;

  QsRand(testfile,t)
end.

Я попытался воткнуть получилось вот что:

program sotrudnik;
uses crt;
Type stud=Record
 Fio:String[15];
 otdel: 1..1000;
 oklad: 1..1000;
 End;
Var Fstud: File of Stud;
a:array[1..10] of integer;
n,i:integer;
s,g:stud;

type
  DataItem = string[80];
  DataArray = array [1..80] of DataItem;
procedure qs(l, r:integer; var it:DataArray);
    var
      i, j: integer;
      x, y: DataItem;
    begin
      i := l; j := r;
      x := it[(l+r) div 2];
        repeat
          while it[i].fio < x.fio do i := i+1;
          while x.fio < it[j].fio do j := j-1;
          if i<=j then
            begin
              y := it[i];
              it[i] := it[j];
              it[j] := y;
              i := i+1; j := j-1;
            end;
        until i>j;
        if l<j then qs(l, j, it);
        if l<r then qs(i, r, it)
    end;
begin
  qs(1, count, item)

function Find(var fp:recfil; i:integer): str80
  var
    t:address;
begin
  i := i-1;
  Seek(fp, i)
  Read(fp, t)
  Find := t.name;
end;

procedure QsRand(var var fp:recfil; count:integer)
  procedure Qs(l, r:integer)
    var
      i, j, s:integer ;
      x, y, z:DataItem;

begin
clrscr;
assign(Fstud, 'C:\file.dat');
reset(Fstud);
writeln('Vvedite kolvo sotrudnikov');
readln(n);
 for i:=1 to n do
 begin
 writeln('Vvedite fio sotrudnika');
 readln(s.FIO);
 writeln('Nomer otdela:');
 readln(s.otdel);
 writeln('Velechina oklada:');
 readln(s.oklad);
 write(Fstud,s);
end;
 close(fstud);
 reset(Fstud);

begin
  i := l; j := r;
  s := (l+r) div 2;
  Seek(fp,s-1); 
  Read(fp,x);
  repeat
    while Find(fp, i) < x.fio do i := i+1;
    while x.fio < Find(fp, j) do j := j-1;
    if i<=j then
      begin
        Seek(fp,i-1);  Read(fp,y);
        Seek(fp,j-1);  Read(fp,z);
        Seek(fp,j-1);  Write(fp,y);
        Seek(fp,i-1);  Write(fp,z);
        i := i+1; j := j-1;
      end;
    until i>y;
    if l<j then qs(l, j)
    if l<r then qs(i, r)
end;
begin
  qs(1,count);
end;
begin
  Assign(testfile, 'C:\file.dat');
  Reset(testfile);
  t := 1;
  while not EOF(testfile) do begin
    Read(testfile,test);
    t := t+1;
  end;
  t := t-1;

  QsRand(testfile,t)
end;

end;
 readln;
 End.

Он фамилии все разбирает по буквам и сортирует все по алфавиту)))
Хз как сделать чтобы слова сортировал, сам начинающий=)
Но всё равно должно помочь, вообщем подумай я что мог сделал):14: :14: