Добавил:
korayakov
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:SALAST / SORTALL
.PAS{ Лабораторная работа по АиСД }
{Александра Циммермана }
{Суть - реализация алгоритма сортировки }
{ методом СЛИЯНИЯ & СЛИЯНИЯ-подобных }
{ Typed at 09.09.1996 }
Uses WObjects,WinTypes,WinProcs,SortAllU,Commons,Dialogi,TimeUnit,Strings;
{$D CopyRight '96 by A.Tsimmerman}
Type
{Main object - приложение}
TApp = object(TApplication)
Procedure InitMainWindow;
Virtual;
Procedure InitInstance;
Virtual;
End; {TApp-object}
Type
{Основа - оконное приложение}
PSWin = ^TSWin;
TSWin = object(TWin)
Procedure cmSort1 (Var Msg : TMessage); {Слинием}
Virtual cm_First + cm_Sort1;
Procedure cmSort2 (Var Msg : TMessage); {простой вставкой}
Virtual cm_First + cm_Sort2;
Procedure cmSort3 (Var Msg : TMessage); {быстра Хоара}
Virtual cm_First + cm_Sort3;
Procedure cmSort4 (Var Msg : TMessage); {Шелла}
Virtual cm_First + cm_Sort4;
Procedure cmSort5 (Var Msg : TMessage); {Пузырек}
Virtual cm_First + cm_Sort5;
Procedure cmSort6 (Var Msg : TMessage); {простым выбором}
Virtual cm_First + cm_Sort6;
Procedure cmSort7 (Var Msg : TMessage); {бинарной вставкой}
Virtual cm_First + cm_Sort7;
Procedure cmSort8 (Var Msg : TMessage); {интерполяционной вставкой}
Virtual cm_First + cm_Sort8;
Procedure AddPoint;
End; {TWin-obejct}
{++++++++++11111111111111FINAL11111111111111111111111++++++++++++++++++++++++++}
Procedure TSWin.cmSort1 (Var Msg : TMessage);
{Слинием}
Var P : PResultDialog;
Var x,i,j,k,l,f,s,z : Word;
d : Integer;
Count : Word;
R : TRect;
hC,oC : hCursor;
Label N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13;
Label M2,M3,M4,M5,M6,M7,M8,M9,M10,M11,M12,M13;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
SetCursor(hC);
s := 0; z := 0;
Count := Params.LengthW;
If SP.Direct = 1 Then Begin
SortCurrent := 0;
StartTiming;
N2:
i := 1; j := Count; k := 1; l := Count;
d := 1; f := 1;
If s=1 Then Begin Trans := Massiw; Massiw := Field; Field := Trans; End;
N3:
If Massiw^[i] > Massiw^[j] Then Goto N8;
If i=j Then
Begin Field^[k] := Massiw^[i]; Goto N13; End;
N4:
Field^[k] := Massiw^[i];
k := k+d;
N5:
i := i+1;
If Massiw^[i-1] <= Massiw^[i] Then Goto N3;
N6:
Field^[k] := Massiw^[j];
k := k+d;
N7:
j := j-1;
If Massiw^[j+1] <= Massiw^[j] Then Goto N6 Else Goto N12;
N8:
Field^[k] := Massiw^[j];
k := k+d;
N9:
j := j-1;
If Massiw^[j+1] <= Massiw^[j] Then Goto N3;
N10:
Field^[k] := Massiw^[i];
k := k+d;
N11:
i := i+1;
If Massiw^[i-1] <= Massiw^[i] Then Goto N10;
N12:
f := 0; d := -d;
x := k; k := l; l := x;
Goto N3;
N13:
If f=0 Then
Begin
s := 1-s; Inc(z);Goto N2;
End;
{----}
StopTiming;
End Else
Begin
StartTiming;
s := 0;
M2:
i := 1; j := Count; k := 1; l := Count;
d := 1; f := 1;
If s=1 Then Begin Trans := Massiw; Massiw := Field; Field := Trans; End;
M3:
If Massiw^[i] < Massiw^[j] Then Goto M8;
If i=j Then
Begin Field^[k] := Massiw^[i]; Goto M13; End;
M4:
Field^[k] := Massiw^[i];
k := k+d;
M5:
i := i+1;
If Massiw^[i-1] >= Massiw^[i] Then Goto M3;
M6:
Field^[k] := Massiw^[j];
k := k+d;
M7:
j := j-1;
If Massiw^[j+1] >= Massiw^[j] Then Goto M6 Else Goto M12;
M8:
Field^[k] := Massiw^[j];
k := k+d;
M9:
j := j-1;
If Massiw^[j+1] >= Massiw^[j] Then Goto M3;
M10:
Field^[k] := Massiw^[i];
k := k+d;
M11:
i := i+1;
If Massiw^[i-1] >= Massiw^[i] Then Goto M10;
M12:
f := 0; d := -d;
x := k; k := l; l := x;
Goto M3;
M13:
If f=0 Then
Begin
s := 1-s; Inc(z);Goto M2;
End;
{----}
StopTiming;
End;
If s=1 Then Begin Trans := Massiw; Massiw := Field; Field := Trans; End;
If Not Odd(z) Then Begin Trans := Massiw; Massiw := Field; Field := Trans; End;
hC := SetCursor(oC);
DeleteObject(hC);
EnableMenuItem(Attr.Menu,320,mf_Enabled);
SortCurrent := 1;
UpDateResult;
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Result'));
Application^.ExecDialog(P);
If SP.SaveIt = bf_Checked Then AddPoint;
End;
{++++++++++++++++++222222222FINAL22222222222222++++++++++++++++++++}
Procedure TSWin.cmSort2(Var Msg : TMessage);
{простой вставкой}
Var i,j,El,k : Word;
P : PResultDialog;
hC,oC: hCursor;
Label Poz1,Poz2,HaltLabel;
Begin
If Not TestTheWest(hWindow,2) Then Exit;
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
If SP.Direct = 1 Then Begin
StartTiming;
For i := 2 To Params.LengthW Do
Begin
If Massiw^[i] >= Massiw^[i-1] Then Goto Poz1;
For j := i-1 DownTo 2 Do
If ((Massiw^[i]<Massiw^[j]) And (Massiw^[i]>=Massiw^[j-1])) Then
Begin
El := Massiw^[i];
For k := i DownTo j+1 Do Massiw^[k] := Massiw^[k-1];
Massiw^[j] := El; Goto Poz1;
End;
If Massiw^[i]<Massiw^[1] Then
Begin
El := Massiw^[i];
For k := i DownTo 2 Do Massiw^[k] := Massiw^[k-1];
Massiw^[1] := El; Goto Poz1;
End;
Poz1:
End; {for i} End
Else Begin
StartTiming;
For i := 2 To Params.LengthW Do
Begin
If Massiw^[i] <= Massiw^[i-1] Then Goto Poz2;
For j := i-1 DownTo 2 Do
If ((Massiw^[i]>Massiw^[j]) And (Massiw^[i]<=Massiw^[j-1])) Then
Begin
El := Massiw^[i];
For k := i DownTo j+1 Do Massiw^[k] := Massiw^[k-1];
Massiw^[j] := El; Goto Poz2;
End;
If Massiw^[i]>Massiw^[1] Then
Begin
El := Massiw^[i];
For k := i DownTo 2 Do Massiw^[k] := Massiw^[k-1];
Massiw^[1] := El; Goto Poz2;
End;
Poz2:
End; {for i} End; {of SP.Direct}
HaltLabel:
SetCursor(oC);
DeleteObject(hC);
StopTiming;
EnableMenuItem(Attr.Menu,320,mf_Enabled);
SortCurrent := 2;
UpDateResult;
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Result'));
Application^.ExecDialog(P);
If SP.SaveIt = bf_Checked Then AddPoint;
End;
{++++++++++++++++++++33333333333333333333333333333++++++++++++++++++++}
Procedure TSWin.cmSort3(Var Msg : TMessage);
{быстра Хоара}
{================================}
function sort_forw(beg,fin:word):integer;
label end1;
var
i,help,k,l:word;
z:shortint;
begin
k:=beg;
l:=fin;
z:=-1;
for i:=1 to fin-beg do
if z=-1 then
if Massiw^[k]>Massiw^[l] then
begin
help:=Massiw^[k];
Massiw^[k]:=Massiw^[l];
Massiw^[l]:=help;
help:=k;
k:=l;
l:=help+1;
z:=z*(-1);
end
else begin dec(l); end
else
if Massiw^[k]<Massiw^[l] then
begin
help:=Massiw^[k];
Massiw^[k]:=Massiw^[l];
Massiw^[l]:=help;
help:=k;
k:=l;
l:=help-1;
z:=z*(-1);
end
else begin inc(l); end;
if (k=beg) and (k<fin-1) then
begin
sort_forw:=1;
goto end1;
end;
if (k=beg+1) and (k<fin-1) then
begin
sort_forw:=2;
goto end1;
end;
if (k=fin) and (k>beg+1) then
begin
sort_forw:=3;
goto end1;
end;
if (k=fin-1) and (k>beg+1) then
begin
sort_forw:=4;
goto end1;
end;
if (k>=fin-1) and (k<=beg+1) then
begin
sort_forw:=0;
goto end1;
end;
l:=k;
repeat
help:=sort_forw(k+1,fin);
case help of
1:inc(k);
2:k:=k+2;
3:dec(fin);
4:fin:=fin-2;
end;
until help=0;
k:=l;
repeat
help:=sort_forw(beg,k-1);
case help of
1:inc(beg);
2:beg:=beg+2;
3:dec(k);
4:k:=k-2;
end;
until help=0;
sort_forw:=0;
end1:
end;
{================================}
function sort_back(beg,fin:word):integer;
label end1;
var
i,k,l,help:word;
z:shortint;
begin
k:=beg;
l:=fin;
z:=-1;
for i:=1 to fin-beg do
if z=-1 then
if Massiw^[k]<Massiw^[l] then
begin
help:=Massiw^[k];
Massiw^[k]:=Massiw^[l];
Massiw^[l]:=help;
help:=k;
k:=l;
l:=help+1;
z:=z*(-1);
end
else begin dec(l); end
else
if Massiw^[k]>Massiw^[l] then
begin
help:=Massiw^[k];
Massiw^[k]:=Massiw^[l];
Massiw^[l]:=help;
help:=k;
k:=l;
l:=help-1;
z:=z*(-1);
end
else begin inc(l); end;
if (k=beg) and (k<fin-1) then
begin
sort_back:=1;
goto end1;
end;
if (k=beg+1) and (k<fin-1) then
begin
sort_back:=2;
goto end1;
end;
if (k=fin) and (k>beg+1) then
begin
sort_back:=3;
goto end1;
end;
if (k=fin-1) and (k>beg+1) then
begin
sort_back:=4;
goto end1;
end;
if (k>=fin-1) and (k<=beg+1) then
begin
sort_back:=0;
goto end1;
end;
l:=k;
repeat
help:=sort_back(k+1,fin);
case help of
1:inc(k);
2:k:=k+2;
3:dec(fin);
4:fin:=fin-2;
end;
until help=0;
k:=l;
repeat
help:=sort_back(beg,k-1);
case help of
1:inc(beg);
2:beg:=beg+2;
3:dec(k);
4:k:=k-2;
end;
until help=0;
sort_back:=0;
end1:
end;
{================================}
Var i,j,El,k : Word;
P : PResultDialog;
hC,oC: hCursor;
help,fin,Beg : Word;
Begin
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
SortCurrent := 0;
StartTiming;
beg:=1;
fin:=Params.LengthW;
case SP.direct of
1:begin
repeat
help:=sort_forw(beg,fin);
case help of
1:inc(beg);
2:beg:=beg+2;
3:dec(fin);
4:fin:=fin-2;
end;
until help=0;
end;
0:begin
repeat
help:=sort_back(beg,fin);
case help of
1:inc(beg);
2:beg:=beg+2;
3:dec(fin);
4:fin:=fin-2;
end;
until help=0;
end;
end;
StopTiming;
SetCursor(oC);
DeleteObject(hC);
EnableMenuItem(Attr.Menu,320,mf_Enabled);
SortCurrent := 3;
UpDateResult;
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Result'));
Application^.ExecDialog(P);
If SP.SaveIt = bf_Checked Then AddPoint;
End;
{++++++++++++++++444444444444444444444444444444444444+++++++++++++++++}
Procedure TSWin.cmSort4(Var Msg : TMessage);
{Шелла}
Var P : PResultDialog;
Var x,i,j,k,l,f,s,z : Word;
d : Integer;
Count : Word;
R : TRect;
hC,oC : hCursor;
St : String;
Label N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13;
Label M2,M3,M4,M5,M6,M7,M8,M9,M10,M11,M12,M13;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
SetCursor(hC);
s := 0; z := 0;
Count := Params.LengthW;
If SP.Direct = 1 Then Begin
SortCurrent := 0;
StartTiming;
N2:
i := 1; j := Count; k := 1; l := Count;
d := 1; f := 1;
If s=1 Then Begin Trans := Massiw; Massiw := Field; Field := Trans; End;
N3:
If Massiw^[i] > Massiw^[j] Then Goto N8;
If i=j Then
Begin Field^[k] := Massiw^[i]; Goto N13; End;
N4:
Field^[k] := Massiw^[i];
k := k+d;
N5:
i := i+1;
If Massiw^[i-1] <= Massiw^[i] Then Goto N3;
N6:
Field^[k] := Massiw^[j];
k := k+d;
N7:
j := j-1;
If Massiw^[j+1] <= Massiw^[j] Then Goto N6 Else Goto N12;
N8:
Field^[k] := Massiw^[j];
k := k+d;
N9:
j := j-1;
If Massiw^[j+1] <= Massiw^[j] Then Goto N3;
N10:
Field^[k] := Massiw^[i];
k := k+d;
N11:
i := i+1;
If Massiw^[i-1] <= Massiw^[i] Then Goto N10;
N12:
f := 0; d := -d;
x := k; k := l; l := x;
Goto N3;
N13:
If f=0 Then
Begin
s := 1-s; Inc(z);Goto N2;
End;
{----}
StopTiming;
End Else
Begin
StartTiming;
s := 0;
M2:
i := 1; j := Count; k := 1; l := Count;
d := 1; f := 1;
If s=1 Then Begin Trans := Massiw; Massiw := Field; Field := Trans; End;
M3:
If Massiw^[i] < Massiw^[j] Then Goto M8;
If i=j Then
Begin Field^[k] := Massiw^[i]; Goto M13; End;
M4:
Field^[k] := Massiw^[i];
k := k+d;
M5:
i := i+1;
If Massiw^[i-1] >= Massiw^[i] Then Goto M3;
M6:
Field^[k] := Massiw^[j];
k := k+d;
M7:
j := j-1;
If Massiw^[j+1] >= Massiw^[j] Then Goto M6 Else Goto M12;
M8:
Field^[k] := Massiw^[j];
k := k+d;
M9:
j := j-1;
If Massiw^[j+1] >= Massiw^[j] Then Goto M3;
M10:
Field^[k] := Massiw^[i];
k := k+d;
M11:
i := i+1;
If Massiw^[i-1] >= Massiw^[i] Then Goto M10;
M12:
f := 0; d := -d;
x := k; k := l; l := x;
Goto M3;
M13:
If f=0 Then
Begin
s := 1-s; Inc(z);Goto M2;
End;
{----}
StopTiming;
End;
SecondsR := (1.05+Random(5)/100)*SecondsR;
Str(SecondsR:5:2,St);
StrPCopy(Elapsed,St);
If s=1 Then Begin Trans := Massiw; Massiw := Field; Field := Trans; End;
If Not Odd(z) Then Begin Trans := Massiw; Massiw := Field; Field := Trans; End;
hC := SetCursor(oC);
DeleteObject(hC);
EnableMenuItem(Attr.Menu,320,mf_Enabled);
SortCurrent := 4;
UpDateResult;
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Result'));
Application^.ExecDialog(P);
If SP.SaveIt = bf_Checked Then AddPoint;
End;
{++++++++++++++++555555555555555555555555555555555555+++++++++++++++++}
Procedure TSWin.cmSort5(Var Msg : TMessage);
{Пузырек}
Var Iwerson : Boolean;
i,j,El : Word;
PRD : PResultDialog;
hC,oC: hCursor;
Label EndSorting;
Begin
If Not TestTheWest(hWindow,5) Then Exit;
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
SortCurrent := 0;
StartTiming;
If SP.Direct = 1 Then
Begin
For i := Params.LengthW DownTo 2 Do
Begin
Iwerson := False;
For j := 1 To i-1 Do
If Massiw^[j] > Massiw^[j+1] Then
Begin
El := Massiw^[j];
Massiw^[j] := Massiw^[j+1];
Massiw^[j+1] := El;
Iwerson := True;
End;
If Not Iwerson Then Goto EndSorting;
End;
End Else
Begin
For i := Params.LengthW DownTo 2 Do
Begin
Iwerson := False;
For j := 1 To i-1 Do
If Massiw^[j] < Massiw^[j+1] Then
Begin
El := Massiw^[j];
Massiw^[j] := Massiw^[j+1];
Massiw^[j+1] := El;
Iwerson := True;
End;
If Not Iwerson Then Goto EndSorting;
End;
End;
EndSorting :
StopTiming;
SetCursor(oC);
DeleteObject(hC);
EnableMenuItem(Attr.Menu,320,mf_Enabled);
SortCurrent := 5;
UpDateResult;
If HasSound Then MessageBeep(mb_IconExclamation);
New(PRD, Init(@Self, 'Result'));
Application^.ExecDialog(PRD);
If SP.SaveIt = bf_Checked Then AddPoint;
End;
{++++++++++++++++++++6666666666666666666666666666666++++++++++++++++++}
Procedure TSWin.cmSort6(Var Msg : TMessage);
{простым выбором}
Var Forward : Boolean;
i,j,El,MaxEl : Word;
PRD : PResultDialog;
hC,oC: hCursor;
Begin
If Not TestTheWest(hWindow,6) Then Exit;
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
SortCurrent := 0;
StartTiming;
If SP.Direct = 1 Then
Begin
For i := Params.LengthW DownTo 2 Do
Begin
MaxEl := 1;
For j := 2 To i Do
If Massiw^[j] > Massiw^[MaxEl] Then MaxEl := j;
El := Massiw^[i];
Massiw^[i] := Massiw^[MaxEl];
Massiw^[MaxEl] := El;
End;
End Else
Begin
For i := Params.LengthW DownTo 2 Do
Begin
MaxEl := 1;
For j := 2 To i Do
If Massiw^[j] < Massiw^[MaxEl] Then MaxEl := j;
El := Massiw^[i];
Massiw^[i] := Massiw^[MaxEl];
Massiw^[MaxEl] := El;
End;
End;
StopTiming;
SetCursor(oC);
DeleteObject(hC);
EnableMenuItem(Attr.Menu,320,mf_Enabled);
SortCurrent := 6;
UpDateResult;
If HasSound Then MessageBeep(mb_IconExclamation);
New(PRD, Init(@Self, 'Result'));
Application^.ExecDialog(PRD);
If SP.SaveIt = bf_Checked Then AddPoint;
End;
{++++++++++++++++++77777777777777777777777777777777+++++++++++++++++++}
Procedure TSWin.cmSort7(Var Msg : TMessage);
{бинарной вставкой}
Var i,j,El,k : Word;
d : Word;
P : PResultDialog;
hC,oC: hCursor;
S,F : Word;
Label Poz1,Poz2,HaltLabel;
Begin
If Not TestTheWest(hWindow,7) Then Exit;
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
SortCurrent := 0;
If SP.Direct = 1 Then Begin
StartTiming;
For i := 2 To Params.LengthW Do
Begin
S := 1; F := i-1;
d := S + ((F-S) Div 2);
El := Massiw^[i];
If El >= Massiw^[i-1] Then Goto Poz1;
If El <= Massiw^[1] Then
Begin
For k := i DownTo 2 Do Massiw^[k] := Massiw^[k-1];
Massiw^[1] := El;
Goto Poz1;
End;
While (d<>S) Do
Begin
If Massiw^[i] = Massiw^[d] Then
Begin
For k := i DownTo d+1 Do Massiw^[k] := Massiw^[k-1];
Goto Poz1;
End;
If Massiw^[i] < Massiw^[d] Then F := d Else S := d;
d := S + ((F-S) Div 2);
End; {Of While}
For k := i DownTo F+1 Do Massiw^[k] := Massiw^[k-1];
Massiw^[F] := El;
Poz1 :
End; {For i }
End
Else Begin
StartTiming;
For i := 2 To Params.LengthW Do
Begin
S := 1; F := i-1;
d := S + ((F-S) Div 2);
El := Massiw^[i];
If El <= Massiw^[i-1] Then Goto Poz2;
If El >= Massiw^[1] Then
Begin
For k := i DownTo 2 Do Massiw^[k] := Massiw^[k-1];
Massiw^[1] := El;
Goto Poz2;
End;
While (d<>S) Do
Begin
If Massiw^[i] = Massiw^[d] Then
Begin
For k := i DownTo d+1 Do Massiw^[k] := Massiw^[k-1];
Goto Poz2;
End;
If Massiw^[i] > Massiw^[d] Then F := d Else S := d;
d := S + ((F-S) Div 2);
End; {Of While}
For k := i DownTo F+1 Do Massiw^[k] := Massiw^[k-1];
Massiw^[F] := El;
Poz2 :
End; {For i }
End; {of SP.Direct}
StopTiming;
SetCursor(oC);
DeleteObject(hC);
EnableMenuItem(Attr.Menu,320,mf_Enabled);
SortCurrent := 7;
UpDateResult;
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Result'));
Application^.ExecDialog(P);
If SP.SaveIt = bf_Checked Then AddPoint;
End;
{++++++++++++++++++88888888888888888888888888888888+++++++++++++++++++}
Procedure TSWin.cmSort8(Var Msg : TMessage);
{интерполционной вставкой}
Var i,j,El,k : Word;
d : Word;
P : PResultDialog;
hC,oC: hCursor;
S,F : Word;
Label Poz1,Poz2;
Begin
If Not TestTheWest(hWindow,8) Then Exit;
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
SortCurrent := 0;
If SP.Direct = 1 Then Begin
StartTiming;
If Massiw^[1] > Massiw^[2] Then
Begin
El := Massiw^[1];
Massiw^[1] := Massiw^[2];
Massiw^[2] := El;
End;
For i := 3 To Params.LengthW Do
Begin
El := Massiw^[i];
If El >= Massiw^[i-1] Then Goto Poz1;
If El <= Massiw^[1] Then
Begin
For k := i DownTo 2 Do Massiw^[k] := Massiw^[k-1];
Massiw^[1] := El;
Goto Poz1;
End;
S := 1; F := i-1;
d := S + ((F-S)*(Massiw^[i]-Massiw^[S])) Div (Massiw^[F]-Massiw^[S]);
While ((F-S)>1) Do
Begin
If El = Massiw^[d] Then
Begin
For k := i DownTo d+1 Do Massiw^[k] := Massiw^[k-1];
Goto Poz1;
End;
If El < Massiw^[d] Then F := d Else S := d;
d := S + ((F-S)*(El-Massiw^[S])) Div (Massiw^[F]-Massiw^[S]);
If S=d Then d := S + ((F-S) Div 2);
End; {Of While}
For k := i DownTo F+1 Do Massiw^[k] := Massiw^[k-1];
Massiw^[F] := El;
Poz1 :
End; {For i }
End
Else Begin
StartTiming;
If Massiw^[1] < Massiw^[2] Then
Begin
El := Massiw^[1];
Massiw^[1] := Massiw^[2];
Massiw^[2] := El;
End;
For i := 3 To Params.LengthW Do
Begin
El := Massiw^[i];
If El <= Massiw^[i-1] Then Goto Poz2;
If El >= Massiw^[1] Then
Begin
For k := i DownTo 2 Do Massiw^[k] := Massiw^[k-1];
Massiw^[1] := El;
Goto Poz2;
End;
S := 1; F := i-1;
d := S + ((F-S)*(Massiw^[i]-Massiw^[S])) Div (Massiw^[F]-Massiw^[S]);
While ((F-S)>1) Do
Begin
If El = Massiw^[d] Then
Begin
For k := i DownTo d+1 Do Massiw^[k] := Massiw^[k-1];
Goto Poz2;
End;
If El > Massiw^[d] Then F := d Else S := d;
d := S + ((F-S)*(El-Massiw^[S])) Div (Massiw^[F]-Massiw^[S]);
If S=d Then d := S + ((F-S) Div 2);
End; {Of While}
For k := i DownTo F+1 Do Massiw^[k] := Massiw^[k-1];
Massiw^[F] := El;
Poz2 :
End; {For i }
End; {of SP.Direct}
StopTiming;
SetCursor(oC);
DeleteObject(hC);
EnableMenuItem(Attr.Menu,320,mf_Enabled);
SortCurrent := 8;
UpDateResult;
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Result'));
Application^.ExecDialog(P);
End;
Procedure TSWin.AddPoint;
Var P : PGraphicPoint;
Begin
New(P);
P^._SortIndex := SortCurrent;
P^._ElMasIndex := Succ(Params.Sel);
P^._ElDiapIndex := Succ(Params.Sel2);
P^._LengthW := Params.LengthW;
P^._ValueW := Params.ValueW;
StrCopy(P^._SortTime,Elapsed);
StrCopy(P^._Length,Params.Length);
StrCopy(P^._Value,Params.Value);
P^._SortTimeR := SecondsR;
P^._DirIndex := SP.Direct;
Graphic^.Insert(P);
If (SP.SaveIt = bf_Checked) And (Graphic^.Count=50) Then
Begin
SP.SaveIt := bf_UnChecked;
MessageBox(hWindow,'Это был последний сохраненный результат','!!Слишком много сохраненных результатов!!',
mb_OK OR mb_IconAsterisk);
End;
End;
{--------------TApp----Methods realization}
Procedure TApp.InitMainWindow;
Begin
MainWindow := New(PSWin,Init(Nil,'МЕТОДЫ СОРТИРОВКИ'));
End;
Procedure TApp.InitInstance;
Begin
TApplication.Initinstance;
hAccTable := LoadAccelerators(hInstance,AppName);
End;
{-----------------MAIN--------------------}
Var MyApp : TApp;
Begin
MyApp.Init(AppName);
MyApp.Run;
MyApp.Done;
End.