Сортировка по алфавиту (паскаль).

[Alenushka7]

Алфавит состоит из 13-ти символов англ.алфавита (q,w,e,r,t,y,u,i,o,p,a,s,d). Имеется список имен (вводим с клавиатуры), который нужно упорядочить по данному алфавиту.

var
     alpha: array [0..12] of char;
     list: array [0..100] of string;
     name,names,temp: string;
     i,c,j: Integer;
     function alph(var x:char):integer;
     begin
          if x = 'q' then
             alph := 0;
          if x = 'w' then
             alph := 1;
          if x = 'e' then
             alph := 2;
          if x = 'r' then
             alph := 3;
          if x = 't' then
             alph := 4;
          if x = 'y' then
             alph := 5;
          if x = 'u' then
             alph := 6;
          if x = 'i' then
             alph := 7;
          if x = 'o' then
             alph := 8;
          if x = 'p' then
             alph := 9;
          if x = 'a' then
             alph := 10;
          if x = 's' then
             alph := 11;
          if x = 'd' then
             alph := 12;
     end;
     begin
         writeln('введите список имен("end" для завершения)');
         i := 0;
         c := 0;
         while not (name = 'end') do begin
             readln(name);
             if name = 'end' then

ребят, дальше, как я понимаю, нужно упорядочивать с последней буквы имени методом пузырька, но как это сделать, я не знаю..



___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

[Poma][a]

const
	ABC = 'qwertyuiopasd';
	SIZE = 1000;

type
	TArr = array [1..SIZE] of string;

procedure ReadArr (var a : TArr; var n : Integer);

var
	i : Integer;

begin
	ReadLn (n);

	for i := 1 to n do
		ReadLn (a[i])
end;

procedure PrintArr (const a : TArr; const n : Integer);

var
	i : Integer;

begin

	for i := 1 to n do
		WriteLn (a[i], ' ')

end;


procedure Swap (var a, b : string);

var
	t : string;

begin
	t := a;
	a := b;
	b := t;
end;


procedure SortArr (var a : TArr; const n : Integer);

function FstStrMore (s1, s2 : string) : Boolean;
var
	i, p1, p2 : Integer;
	
begin
	p1 := Length(s1) - Length(s2);
	
	if p1 <> 0 then begin
		FstStrMore := (p1 > 0);
		Exit
	end;
	
	i := 1;
	
	while (i <= Length(s1)) do begin
		if s1[i] <> s2[i] then begin
			p1 := Pos (s1[i], ABC);
			p2 := Pos (s2[i], ABC);
			FstStrMore := p1 < p2;
			Exit;
		end;
		Inc (i)
	end;
	
	FstStrMore := FALSE
			
end;

var
	i, j : Integer;

begin
	for i := 1 to n-1 do
		for j := 1 to n-i do
			if FstStrMore (a[j], a[j+1]) then
				Swap (a[j], a[j+1]);
end;

var
	a : TArr;
	n : Integer;

begin
	ReadArr (a, n);

	SortArr (a, n);

	PrintArr (a, n)
end.