Скачиваний:
11
Добавлен:
15.06.2014
Размер:
3.9 Кб
Скачать
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Button2: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
BitBtn1: TBitBtn;
Label3: TLabel;
Label4: TLabel;
Edit2: TEdit;
Edit3: TEdit;
Label5: TLabel;
Label6: TLabel;
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;
s, stack:TSel;

procedure AddStack(var Sp:TSel; S:integer);
procedure ReadStack(var Sp:TSel; s:integer);
procedure CheckMem(var stack:TSel);
procedure ClearMem(var stack:TSel);
procedure Print_B(stack:TSel;listbox:Tlistbox);


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 ReadNStack(sp:Tsel; n:integer; var s:integer);
var i:integer;
begin
i:=1;
while (i<>n) and (Sp<>nil) do
begin
Inc(i);
Sp:=Sp^.a;
end;
if i=n then s:=sp^.inf
else ShowMessage('Элемент <n');
end;

Procedure ReadStack(var Sp:TSel; s:integer);
var spt:TSel;
begin
if Sp=nil then ShowMessage('Стек пуст')
else begin
S:=Sp^.inf;
Spt:=Sp;
Sp:=Sp^.a;
Dispose(Spt);
end;
end;

Procedure Rev12After(spi:TSel);
var sp:TSel;
begin
sp:=spi^.a^.a;
spi^.a^.a:=sp^.a;
sp^.a:=spi^.a;
spi^.a:=sp;
end;

Procedure Rev21(spi:Tsel);
Var Inf:integer;sp:TSel;
begin
Inf:=spi^.inf;
spi^.inf:=sp^.a^.inf;
spi^.a^.inf:=Inf;
end;

Procedure SortBublAfter(spm1:Tsel);
var sp,spt:Tsel;
begin
if spm1^.a=nil then exit;
spt:=nil;
repeat
sp:=spm1;
while sp^.a^.a<>spt do begin
if sp^.a^.inf>sp^.a^.a^.inf then
Rev12After(sp);
sp:=sp^.a;
end;
spt:=sp^.a;
until spm1^.a^.a=spt;
end;

Procedure SortBublInf(sp1:Tsel);
var sp,spt:Tsel;
begin
spt:=nil;
repeat
sp:=sp1;
while sp^.a<>spt do begin
if sp^.inf>sp^.a^.inf then Rev21(sp);
sp:=sp^.a;
end;
spt:=sp
until sp1^.a=spt;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i,x,n:integer;
begin
listbox1.Clear;
n:=strtoint(edit1.text);
randomize;
CheckMem(s);
for i:=1 to n do begin
x:=random(99)+1;
AddStack(s,x);
end;
print_b(s,listbox1);
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 TForm1.Button2Click(Sender: TObject);
var top,VremUk:TSel;
min,max,pos1, pos, pos2,tempPos:integer;
begin
listbox2.Clear;
VremUk:=s;
pos1:=0;
tempPos:=-1;
min:=VremUk^.inf;
while VremUk<>nil do begin
inc(tempPos);
if min>VremUk.inf then begin
min:=VremUk.inf;
pos1:=tempPos;
end;
Edit2.Text:='min='+IntToStr(min)+' '+IntToStr(pos1+1)+'-ой с вершины';
VremUk:=VremUk^.a;
end;
VremUk:=s;
pos2:=0;
tempPos:=-1;
max:=VremUk^.inf;
while VremUk<>nil do begin
inc(tempPos);
if max<VremUk.inf then begin
max:=VremUk.inf;
pos2:=tempPos;
end;
Edit3.Text:='max='+IntToStr(max)+' '+IntToStr(pos2+1)+'-ой с вершины';
VremUk:=VremUk^.a;
end;
VremUk:=s;
pos:=0;
tempPos:=-1;
while VremUk<>nil do begin
inc(tempPos);
if tempPos=pos1 then VremUk.inf:=max;
if tempPos=pos2 then VremUk.inf:=min;
VremUk:=VremUk^.a;
end;
print_b(s,listbox2);
end;

end.

Соседние файлы в папке меняет местами max и min
  • #
    15.06.201456 б12readme.txt
  • #
    15.06.20147.42 Кб12Unit1.dcu
  • #
    15.06.20143.28 Кб11Unit1.dfm
  • #
    15.06.20143.9 Кб11Unit1.pas
  • #
    15.06.20141.5 Кб11Unit1.~dfm
  • #
    15.06.20143.71 Кб11Unit1.~pas