АСОИ, Delphi, много вариантов 2 сем / 2стеки / алфавитная / Unit1

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
ListBox1: TListBox;
Label1: TLabel;
Label2: TLabel;
Button2: TButton;
ListBox2: TListBox;
BitBtn1: TBitBtn;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Type Tsel=^Sel;
Sel=Record
inf:string;
a:Tsel
end;


var
Form1: TForm1;
Dob:string;
s1:Tsel;

implementation

{$R *.dfm}

procedure AddStack(var Sp:TSel; S:string);
var Spt:TSel;
begin
New(spt);
spt^.inf:=s;
spt^.a:=Sp;
Sp:=spt;
end;

procedure Print(var stack:Tsel; listBox:TListBox);
begin
while stack<>nil do begin
listbox.items.add(stack^.inf);
stack:=stack^.a;
end;
end;

//Процедура извлечения числа из стека с освобождением памяти
Procedure FromStack(var p:Tsel; var n:string);
var pt:Tsel;
Begin
if p<> nil then Begin
pt:=p; //Запоминаем старое значение вершины стека
n:=p^.inf; //Извлекаем число из текущего элемента стека
p:=p^.a; //Устанавливаем новый указатель на вершину стека
end //else n:=0;
end;


//Процедура однократного прохода постеку и замены значений соседних
//элементов стека, если их значения в направлении от вершины ко дну стека не
// не возрастают
Procedure exchange(var p:Tsel; var n:integer);
var nt:string;
begin
if p^.a<> nil then Begin //проверка наличия следующего элемента стека
if length(p^.inf)>length(p^.a^.inf) then Begin //проверка на возрастание значений стека
nt:=p^.inf; //Запоминаем значение числа в вершине стека
p^.inf:= p^.a^.inf;
p^.a^.inf:=nt;
inc(n); //увеличиваем счетчик перестановок на единицу
end;
exchange(p^.a,n); //Рекурсивно вновь вызываем процедуру перестановок
end;
end;

//Процедурв упорядочения элементов стека методом "пузырька"
procedure SortStack(var p:Tsel);
var n:integer;
Begin
Repeat // Открытие цикла упорядочений
n:=0;//Счетчик числа перестановок за один проход полагаем равным нулю
exchange(p,n); //вызываем процедуру однопроходного упорядочевания
//продолжаем цикл, пока не будет ни однойперестановки
until n=0;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Dob:=Edit1.Text;
Edit1.Clear;
Edit1.SetFocus;
AddStack(s1,Dob);
ListBox1.Items.Add(Dob);
end;

procedure TForm1.Button2Click(Sender: TObject);
var i:string;
begin
listbox2.Clear; //Очистка Memo2
SortStack(s1); //Сортировка стека
while s1<>nil do Begin //Проход по стеку
Fromstack(s1,i); //Извлечение элемента из стека и освобождение памяти
ListBox2.Items.Add(i);
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
listbox1.Clear;
listbox2.Clear;
end;

end.