program Project1;
uses SysUtils;
const max=10;
var my_list: array[1..max] of string;
choice:char;
finish:Boolean;
procedure bubble_sort_asc;
var i,j:integer;
temp: string;
begin
for i:= 1 to max -1 do
for j := i + 1 to max do
if my_list[i] > my_list[j] then
begin
temp:=my_list[i];
my_list[i] := my_list[j];
my_list[j] := temp;
end;
end;
procedure bubble_sort_desc;
var i,j:integer;
temp: string;
begin
for i:= 1 to max -1 do
for j := i + 1 to max do
if my_list[i] < my_list[j] then
begin
temp:=my_list[i];
my_list[i] := my_list[j];
my_list[j] := temp;
end;
end;
procedure get_data;
var i:integer;
begin
for i := 1 to max do
begin
writeln('Enter name ',i);
readln(my_list[i]);
end;
end;
procedure display;
var i:integer;
begin
for i := 1 to max do
writeln(my_list[i]);
end;
begin
finish:=false;
repeat
writeln('Program to read names and sort them');
writeln('1:Enter data');
writeln('2:Display data');
writeln('3:Sort data ascending');
writeln('4:Sort data descending');
writeln('5:Quit');
writeln('Enter a number 1-5');
readln(choice);
case choice of
'1': get_data;
'2': display;
'3': bubble_sort_asc;
'4': bubble_sort_desc;
'5': finish:=true;
end;
until finish;
end.
In this code the array is traversed repeatedly from 1 to n-1. If pairs of numbers are swapped then the flag is set to false. The flag is reset to true in the outer repeat loop. If the flag is true at the end of the inner for loop then the list is sorted and the program finishes. This should give this version a slightly better performance in some cases as it does not compare every possible pair before finishing: if the list is sorted at the end of any pass of the inner loop then the flag will remain true and the process will finish.