3.6. Текст программы, выполняющей сортировку массива символов способом простых вставок

procedure TForm1.Button1Click(Sender: TObject);

begin

if (strtoint(edit1.text)<1) or (strtoint(edit1.text)>10000)

THEN

begin

showmessage

('OШИБКА. ВВЕДИТЕ ЧИСЛО ИЗ ОТРЕЗКА [1..10 000]');

elements:=0;

end

else

elements:=strtoint(edit1.text);

stringgrid1.colcount:=elements;

for i:=1 to elements do stringgrid1.cells[i-1,0]:=inttostr(random(10000));

for i:=1 to elements do mas1[i]:=strtoint(stringgrid1.cells[i-1,0]);

button2.Visible:=true;

N2.Enabled:=true;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

for j:=2 to elements do

begin

i:=j-1;

if mas1[j]<mas1[i] then

repeat

i:=i-1;

until mas1[j]>=mas1[i];

contr:=mas1[j];

for k:=j downto (i+1) do

mas1[k]:=mas1[k-1];

mas1[i+1]:=contr;

end;

stringgrid2.ColCount:=elements;

for i:=1 to elements do StringGrid2.Cells[i-1,0]:=IntToStr(mas1[i]);

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

Button1.Click;

T1:= Time; for j:=2 to elements do

begin

i:=j-1;

if mas1[j]<mas1[i]

THEN

REPEAT

i:=i-1;

until mas1[i]<=mas1[j];

contr:=mas1[j];

for k:=j downto (i+1) do

mas1[k]:=mas1[k-1];

mas1[i+1]:=contr;

for f:=i to elements do begin t2:=time;

DecodeTime((T1-T2), h, min, s, ms);

mas2[f]:=IntToStr(s) + ' s ' + IntToStr(ms) + ' ms';

end;

end;

stringgrid2.ColCount:=elements;

for i:=1 to elements do

StringGrid2.Cells[i-1,0]:=IntToStr(mas1[i]);

label1.caption:='Общее время сортировки: '+ IntToStr(s) +

' s ' + IntToStr(ms) + ' ms'; stringgrid3.ColCount:=elements;

for i:=1 to elements do StringGrid3.Cells[i-1,0]:=(mas2[i]);

Label5.Caption:='Время сортировки каждого элемента массива';

Button5.Visible:=true;

Button6.Visible:=true;

N101.Enabled:=true;

N1001.Enabled:=true;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

for i:=1 to elements do

begin

l:=i*10;

mas3[i]:=mas2[l];

end;

stringgrid3.ColCount:=elements div 10;

for i:=1 to elements do StringGrid3.Cells[i-1,0]:=(mas3[i]);

Label5.Caption:='ВРЕМЯ СОРТИРОВКИ КАЖДОГО 10-ГО ЭЛЕМЕНТА МАССИВА';

if elements<10

THEN

showmessage

('ВВЕДИТЕ ЧИСЛО ЭЛЕМЕНТОВ НЕ МЕНЬШЕ ДЕСЯТИ!');

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

for i:=1 to elements do

begin

l:=i*100;

mas4[i]:=mas2[l];

end;

stringgrid3.ColCount:=elements div 100;

for i:=1 to elements do StringGrid3.Cells[i-1,0]:=(mas4[i]);

Label5.Caption:='Время сортировки каждого 100-го элемента массива';

if elements<100

THEN

showmessage

('ВВЕДИТЕ ЧИСЛО ЭЛЕМЕНТОВ');

end;

procedure TForm1.N1Click(Sender: TObject);

begin

Button1.Click;

N2.Enabled:=true;

end;

{процедура, осуществляющая поиск заданного образца в упорядоченном массиве символов методом бинарного поиска}

procedure TForml.Button6Click(Sender: TObject);

Var

obr: integer; //Образец, который нужно найти в массиве

Sred: integer; / / Адрес среднего элемента поделённого массива

usl: boolean; //Досрочное условие выхода из цикла

lv, pr: integer; / /Левый и правый диапазоны массива

begin

1f edit2.text=’’ then

begin

Showmessage

('HE ВВЕДЁН ЭЛЕМЕНТ ДЛЯ ПОИСКА');

exit;

End;

1fp<>l then

begin

Shоwmеssаgе

('МАССИВ НЕ ОТСОРТИРОВАН');

exit;

end;

obr:=strtoint( edit2.text);

1foo=1

THEN

BEGIN

usl:=false;

lv:=l;

pr:=l;

i:=0;

{Цикл поиска элемента в массиве, отсортированном по возрастанию}

REРЕАТ

i:=i+ 1;

IF pr<lv TНEN

begin

edit3.Text:= 'НЕТ ЭЛЕМЕНТА';

exit;

еnd;

ELSE

sred:=(lv+pr) div 2;

IF obr<c(sred)

TНEN

pr:=sred-l;

IF obr>c(sred)

TНEN

lv:=sred+ 1;

IF obr=c(sred)

THEN

begin

edit3. text:=inttostr(sred);

usl:=true;

end;

If i=l then begin

Edit3.text:= 'НЕТ ЭЛЕМЕНТА';

exit;

End;

UNTIL (usl=true) or (edit3.Text='НЕТ ЭЛЕМЕНТА');

END;

{Окончание операции поиска}

If 00=-1 then

BEGIN

usl:=false;

Iv:=l;

pr:=l;

i:=0;

{Цикл поиска элемента в массиве, отсортированном по убыванию}

REPEAT

i:=i+ 1;

If pr<Iv then

begin

edit3.Text:= 'нет элемента';

exit;

end

else

sred:=(lv+pr) div 2;

If obr=c(sred) then

begin

edit3. Text:=inttostr(sred);

usl:=true;

end;

If obr>c(sred) then

pr:=sred-l;

If obr<c(sred) then

lv:=sred+ 1;

If i=l then begin Edit3.text:='нет элемента';

exit;

end;

Until (Edit3.text='нет элемента') or (usl=true);

{конец поиска}

End;

End;

END.