1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
program tabliza; uses crt; const n=10; type ANk=record npp:1..n; FIO:string[13]; Adr:string[15]; Dr:string[8]; tel:string[7]; Ocen:array[1..5] of 2..5; SrB:real; end; var A12:array[1..n] of Ank; nom,i,j,k,h,y:integer;s:integer;min:string;g:ANk
После введения данных необходимо организовать диалог по сортировке(прямой метод сортировки) полей таблицы при помощи процедуры.Т.е. будем вводить название поля(или маркер,указывающий на конкретное поле) по которому нужно сортировать и это станет входящим параметром процедуры.После выводим результат сортировки.Подскажите,пожалуйста, как сделать такую процедуру.
List = array [1..N] of TInfo; TFunc = Function(T1, T2: TInfo): Integer;
{ *** comparison functions } function CompareNpp (T1,T2: TInfo): integer; far; begin if T1.Npp > T2.Npp then CompareNpp := 1 else if T1.Npp = T2.Npp then CompareNpp := 0 else CompareNpp := -1 end; function CompareFio (T1,T2: TInfo): integer; far; begin if T1.Fio > T2.Fio then CompareFio := 1 else if T1.Fio = T2.Fio then CompareFio := 0 else CompareFio := -1 end; function CompareAdr (T1,T2: TInfo): integer; far; begin if T1.Adr > T2.Adr then CompareAdr := 1 else if T1.Adr = T2.Adr then CompareAdr := 0 else CompareAdr := -1 end; function CompareDr (T1,T2: TInfo): integer; far; begin if T1.Dr > T2.Dr then CompareDr := 1 else if T1.Dr = T2.Dr then CompareDr := 0 else CompareDr := -1 end; function CompareTel (T1,T2: TInfo): integer; far; begin if T1.Tel > T2.Tel then CompareTel := 1 else if T1.Tel = T2.Tel then CompareTel := 0 else CompareTel := -1 end; function CompareSrB (T1,T2: TInfo): integer; far; begin if T1.SrB > T2.SrB then CompareSrB := 1 else if T1.SrB = T2.SrB then CompareSrB := 0 else CompareSrB := -1 end;
procedure QuickSort(marker: SortBy; var A: List; Lo, Hi: Integer); var i,j: integer; x, y: TInfo;
procedure Sort (l, r: Integer); begin repeat x := A[(l+r) shr 1]; i := l; j := r; repeat while Compare[marker]( A[i], x ) < 0 do inc(i); while Compare[marker]( A[j], x ) > 0 do dec(j); if i <= j then begin y := A[i]; A[i] := A[j]; A[j] := y; inc(i); dec(j); end; until i > j;
if l < j then Sort (l, j); l := i; until l >= r; end;
Procedure PrintData; Var i: integer; Begin For i := 1 To n Do With data[i] Do Writeln(npp:2, ' ', fio:10, ' ', adr:6, ' ', dr:8, ' ', tel:6, ' ', srb:5:2); End;