Не понимаю, в чем ошибка. Уже все перепробовал. Код:
unit Unit3;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons, StdCtrls;
type
uk=^O;
O=object
data:integer;
next:uk;
end;
type
{ TForm3 }
TForm3 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Button1: TButton;
Image1: TImage;
Image10: TImage;
Image11: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
Image7: TImage;
Image8: TImage;
Image9: TImage;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure closedln(k:integer);
procedure CreateLol(var first: uk; s: string);
procedure printi(k,n:integer);
procedure Push(var stack: uk; inf: integer);
function Empty(stack: uk): boolean;
function Pop(var stack: uk): integer;
procedure SortStack(var first: uk; var second: uk; var third: uk);
procedure PrintStack(second: uk);
procedure Viv(second1: uk);
private
{ private declarations }
public
{ public declarations }
end;
var
Form3: TForm3;
first, second, third : uk;
implementation
uses Unit4;
{$R *.lfm}
{ TForm3 }
procedure TForm3.closedln(k:integer); //удаление картинки с формы
begin
case k of
1:Image2.Visible:=false;
2:Image3.Visible:=false;
3:Image4.Visible:=false;
4:Image5.Visible:=false;
5:Image6.Visible:=false;
6:Image7.Visible:=false;
7:Image8.Visible:=false;
8:Image9.Visible:=false;
9:Image10.Visible:=false;
10:Image11.Visible:=false;
end;
end;
procedure TForm3.printi(k, n : integer); //вывод картинки в положенном месте
var
s1:string;
begin
Application.ProcessMessages();
s1 := inttostr(n);
s1 := s1 +'.png';
case k of
1:begin
Image2.Picture.LoadFromFile(s1);
Image2.Visible:=true;
end;
2:begin
Image3.Picture.LoadFromFile(s1);
Image3.Visible:=true;
end;
3:begin
Image4.Picture.LoadFromFile(s1);
Image4.Visible:=true;
end;
4:begin
Image5.Picture.LoadFromFile(s1);
Image5.Visible:=true;
end;
5:begin
Image6.Picture.LoadFromFile(s1);
Image6.Visible:=true;
end;
6:begin
Image7.Picture.LoadFromFile(s1);
Image7.Visible:=true;
end;
7:begin
Image8.Picture.LoadFromFile(s1);
Image8.Visible:=true;
end;
8:begin
Image9.Picture.LoadFromFile(s1);
Image9.Visible:=true;
end;
9:begin
Image10.Picture.LoadFromFile(s1);
Image10.Visible:=true;
end;
10:begin
Image11.Picture.LoadFromFile(s1);
Image11.Visible:=true;
end;
end;
end;
procedure TForm3.CreateLol(var first: uk; s: string);//создание стека
var
k, kol: integer;
begin
k:=0;
kol:=0;
repeat
k := k + 1;
if (s[k]='1') and (k+1<=length(s)) and (s[k+1]='0') then
begin
Push(first,10);
k+=1;
kol+=1;
end
else
if (s[k] in ['0'..'9']) then
begin
Push(first,StrToInt(s[k]));
kol+=1;
end;
until k>=length(s);
end;
procedure TForm3.BitBtn2Click(Sender: TObject);//закрытие формы
begin
form3.close;
end;
procedure TForm3.Button1Click(Sender: TObject);
var
i: integer;
s: string;
begin
Application.ProcessMessages();
new(first);//создаем три указателя и обнуляем их
new(second);
new(third);
first:= nil;
second:= nil;
third:= nil;
s := Unit4.s;
Application.ProcessMessages();
CreateLol(first, s);
Application.ProcessMessages();
viv(first);
SortStack(first, second, third);
Application.ProcessMessages();
PrintStack(second);
end;
procedure TForm3.BitBtn1Click(Sender: TObject);
begin
end;
procedure TForm3.Viv(second1: uk);//вывод стека в ShowBox
var
newUk, newUk2: uk;
s: string;
begin
new(newUk);
new(newUk2);
s:= '';
newUk:= second1;
while ( Empty(newUk) = false ) do begin
s:= s + inttostr(newUk^.data);
s:= s + ' ';
newUk2:= newUk^.next;
newUk:= newUk2;
end;
s:= 'Вывожу стек: ' + s;
ShowMessage(s);
end;
procedure TForm3.SortStack(var first: uk; var second: uk; var third: uk);//сортировка стека first, результат - в стек second
var
el: integer;
begin
Application.ProcessMessages();
ShowMessage ('Начинаю сортировать');
while ( Empty(first) = false ) do begin //ПОКА не пуст ПервСтек ВЫПОЛНЯТЬ:
//ЕСЛИ РезСтек пуст ИЛИ Вершина.РезСтек < Вершина.ПервСтек ТОГДА
if ( ( Empty(second) = true ) or ( second^.data < first^.data ) ) then
Push(second, Pop(first))//ДОСТАТЬ вершину из ПервСтек и ДОБАВИТЬ в РезСтек,
else //ИНАЧЕ
begin
if (third = nil) then ShowMessage ('third = nil ');
//ПОКА не пуст РезСтек ИЛИ Вершина.РезСтек > Вершина.ПервСтек ВЫПОЛНЯТЬ:
while ( ( Empty(second) = false ) or ( second^.data > first^.data ) ) do
Push( third, Pop(second) );//ДОСТАТЬ вершину из РезСтек и ДОБАВИТЬ во ВремСтек.
Push(second, pop(first));//ДОСТАТЬ вершину из ПервСтек и ДОБАВИТЬ в РезСтек.
while ( Empty(third) = false ) do//ПОКА не пуст ВремСтек:
Push(second, Pop(third)); //ДОСТАТЬ вершину из ВремСтек и ДОБАВИТЬ в РезСтек.
end;
Application.ProcessMessages();
end;
end;
procedure TForm3.Push(var stack: uk; inf: integer); //добавление элемента в стек, на вход указатель стека и data
var
newUk : uk;
begin
new(newUk);
Application.ProcessMessages();
if ( stack = nil ) then
begin
newUk^.data:= inf;
newUK^.next:= stack;
end
else
begin
newUk^.data:= inf;
newUK^.next:= stack;
end;
stack:= newUK;
end;
function TForm3.Empty(stack: uk): boolean;//проверка на пустоту. True - пустой, False - нет
begin
Application.ProcessMessages();
if ( stack = nil ) then
Empty:= true
else
Empty:= false;
end;
function TForm3.Pop(var stack: uk): integer; //удаление элемента из стека
var
newUk : uk;
begin
if (stack <> nil) then
begin
Application.ProcessMessages();
Pop:= stack^.data;
new(newUk);
newUk:= stack;
stack:= stack^.next;
dispose(newUk);
end
else
ShowMessage ('В попе почему-то у нас нил');//на случай ошибок
end;
procedure TForm3.PrintStack(second: uk); //выводит результат сортировки на форму
var
i: integer;
begin
Application.ProcessMessages();
i:= 0;
while ( Empty(second) = false) do begin
Application.ProcessMessages();
i:= i + 1;
printi(i,pop(second)); //сам вывод картинки
end;
end;
procedure TForm3.FormCreate(Sender: TObject);
var
i: integer;
begin
for i := 1 to 10 do//закрывает все картинки на форме
closedln(i);
end;
end.
Ошибка в:
Push( third, Pop(second) );//ДОСТАТЬ вершину из РезСтек и ДОБАВИТЬ во ВремСтек.
Три скрина: ошибка, алгоритм, форма (при выводе отсортированного стека)
Алгоритм работает на отсортированном стеке, но падает на неотсортированном при попытке добавления (Push) элемента 3 стек (third)
Почему падает, не ясно. До этого прекрасно процедура Push работает со стеком номер 1 (first) и стеком номер 2 (second).