unit Unit1;

interface

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

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

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

var
Form1: TForm1;
s1,s2,spt, stack:TSel;
i,x,n1,n2:integer;

procedure AddStack(var Sp:TSel; S:integer);
procedure CheckMem(var stack:TSel);
procedure ClearMem(var sp:TSel);
procedure Print_B(stack:TSel;listbox:Tlistbox);
Procedure exchange(var p:Tsel; var n:integer);
procedure SortStack(var p:Tsel);
procedure FromStack(var p:Tsel; var n:integer);


implementation

{$R *.dfm}
procedure AddStack(var Sp:TSel; S:integer);
var Spt:TSel;
begin
New(spt);
spt^.inf:=s;
spt^.a:=Sp;
Sp:=spt;
end;

Procedure exchange(var p:Tsel; var n:integer);
var nt:word;
begin
if p^.a<> nil then Begin //проверка наличия следующего элемента стека
if p^.inf>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 CheckMem;
begin
while stack<>nil do ClearMem(stack);
end;

procedure Print_B;
begin
while stack<>nil do begin
listbox.items.add(inttostr(stack^.inf));
stack:=stack^.a;
end;
end;

procedure ClearMem(var sp:TSel);
begin
if stack=nil then exit;
sp:=stack;
stack:=stack^.a;
dispose(sp);
end;

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


procedure TForm1.Button1Click(Sender: TObject); //Сформировать
begin
listbox1.Clear;
listbox2.Clear;
n1:=strtoint(edit1.text);
n2:=strtoint(edit2.text);
randomize;
CheckMem(s1);
for i:=1 to n1 do begin
x:=random(99)+1;
AddStack(s1,x);
end;
print_b(s1,listbox1);
for i:=1 to n2 do begin
x:=random(99)+1;
AddStack(s2,x);
end;
print_b(s2,listbox2);
end;

procedure TForm1.Button2Click(Sender: TObject); //Объединить
var i:integer;
begin
listbox3.Clear;
for i:=1 to n2 do begin
x:=S2^.inf;
Spt:=S2;
S2:=S2^.a;
AddStack(s1,x);
end;
SortStack(s1); //Сортировка стека
while s1<>nil do Begin //Проход по стеку
Fromstack(s1,i);
ListBox3.Items.Add(IntToStr(i));
end;
end;


end.

Соседние файлы в папке склеить стеки.результат отсортирован
  • #
    15.06.20142.06 Кб10Project2.dof
  • #
    15.06.2014216 б11Project2.dpr
  • #
    15.06.20141.95 Кб11Unit1.dfm
  • #
    15.06.20143.44 Кб10Unit1.pas