Írjunk programot, amely a legfontosabb rendező eljárásokat szemlélteti. A számok 0..9. Minden szám egy kártyán legyen látható. A rendezés a grafikus képernyőn megjelenő, a számokat tartalmazó lapok legyenek, és lassan hajtsa végre (a grafika miatt túlságosan egyébként sem gyors) a cseréket, közben számolja és jelenítse meg a lépések számát. A rendezés menüből legyen választható. Lehessen véletlen elrendezést kérni, és ugyanolyan kiindulásból, különböző módszerekkel rendezni, a lépések számának összehasonlíthatósága miatt.

A futási képek:

Program Rendez;

Uses NewDelay, Crt, CrtPlus, Graph, Drivers;

Const Sor=210;  {a kártyasor y koord}
Lk=15;    {a lapok kezdő x koord}
      Db=9;     {a kártyák száma-1}
Lt=62;    {a lapok távolsága}
Ls=52;    {a lapok szélessege és magassága}
Bm=4;     {szám és betűméret}
Bx=5;     {a szám helye a lapon - x koord}
By=5;     {a szám helye a lapon - y koord}
Emp=1;   {a várakozási idő}

Type TLap= Object
             FX, FY, FD, FS: Integer;
Procedure Init(IX, IY, ID, IS: Integer);
Procedure Show;
Procedure Hide;
Procedure MoveRel(DX, DY: Integer);
Function GetX:Integer;
Function GetY:Integer;
Function GetS:Byte;
End;

Const MSor: Array[1..10] Of String[30]=
            (' Keverés                      ',
             ' Közvetlen összehasonlítással ',
             ' Buborék módszerrel           ',
             ' Javított buborék módszerrel  ',
             ' Shell rendezés               ',
             ' Kiválasztással               ',
             ' Beszúrással                  ',
' Javított beszúrással         ',
             ' Quick rendezéssel            ',
             ' Kilépés a programból         ');

Procedure TLap.Init(IX, IY, ID, IS: Integer);
Begin
  FX:= IX; FY:= IY; FD:= ID; FS:= IS;
End;

Procedure TLap.Show;
Var W: String;
Begin
  Bar(GetX, GetY, GetX+FD, GetY+FD); Str(GetS, W);
SetTextStyle(0, 0, Bm);
SetColor(6); OutTextXY(GetX+Bx, FY+By, W);
End;

Procedure TLap.Hide;
Begin
SetViewPort(GetX, GetY, GetX+FD, GetY+FD, ClipOn);
ClearViewPort;
SetViewPort(0, 0, GetMaxX, GetMaxY, ClipOff);
End;

Procedure TLap.Moverel(DX, DY: Integer);
Begin
Hide; FX:= GetX + DX; FY:= GetY + DY; Show;
End;

Function TLap.GetX:Integer;
Begin
GetX:= FX;
End;

Function TLap.GetY:Integer;
Begin
GetY:= FY;
End;

Function TLap.GetS:Byte;
Begin
GetS:= FS;
End;

Var Mx, My, Sz: Integer;
    Lap: Array[0..Db] Of TLap;
    M, T, P: Array[0..Db] Of Byte;
    I, Mp: Byte;
    Kevert: Boolean;

Procedure Init;
Var Gd, Gm: integer;
Begin
Gd:= Detect; InitGraph(Gd, Gm, 'C:\Tp\Bgi');
Mx:= GetMaxX; My:= GetMAxY;
End;

Procedure Lapkepre;
Var I: Byte;
Begin
ClearDevice;
For I:= 0 To Db Do Lap[I].Init(I*Lt+Lk, Sor, Ls, P[I]);
For I:= 0 To Db Do Lap[I].Show;
End;

Procedure Keveres;
Var I, V: Byte;
Begin
Randomize;
For I:= 0 To Db Do M[I]:=0;
For I:= 0 To Db Do
Begin
Repeat
      V:= Random(Db+1);
Until M[V]=0;
    M[V]:= 1;
    T[I]:= V;
End;
For I:= 0 To Db Do P[I]:= T[I];
End;

Procedure Csere(A, B: byte);
Var U, V: Integer;
    I: Integer;
Begin
  U:= Lap[A].GetX;
  V:= Lap[B].GetX;

For I:= 1 To Lt Do
Begin
    Lap[A].MoveRel(0,-1);
    Lap[B].MoveRel(0, 1);
End;

For I:= U to V do
Begin
    Lap[A].MoveRel( 1,0);
    Lap[B].Moverel(-1,0);
End;

For I:= 1 To Lt Do
Begin
    Lap[A].MoveRel(0, 1);
    Lap[B].MoveRel(0,-1);
End;
End;

Procedure Jobbra(A: byte);
Var I: Integer;
Begin
For I:= 1 To Lt Do Lap[A].MoveRel(1,0);
End;

Procedure Le(A: Byte);
Var I: Integer;
Begin
For I:= 1 To Lt Do Lap[A].MoveRel(0,1);
End;

Procedure Balra(B: Byte);
Var I: Integer;
Begin
For I:= 1 To Lt do Lap[B].MoveRel(-1,0);
End;

Procedure Fel(B: Byte);
Var I: Integer;
Begin
For I:=1 To Lt Do Lap[B].MoveRel(0,-1);
End;

Procedure Szamol;
Var Ws: String;
Begin
  Inc(Sz);
Str(Sz,Ws);
SetViewPort(0,0,100,100,ClipOn);
ClearViewPort;
SetViewPort(0,0,Mx,My,ClipOff);
OutTextXY(10,10,Ws);
End;

Procedure Kozvetlen;
Var I, J: Byte;
P: TLap;
Begin
Sz:= 0;
For I:= 0 To Db-1 Do For J:=I+1 To Db Do
If Lap[i].GetS>Lap[j].GetS Then
Begin
    Csere(I,J);
    P:= Lap[I];
    Lap[I]:= Lap[J];
    Lap[J]:= p;
Szamol;
Delay(Emp);
End;
End;

Procedure Buborek;
Var I, J: Byte;
    P: TLap;
Begin
Sz:= 0;
For J:= 0 To Db-1 Do
For I:= 0 To Db-1 Do
If Lap[I].GetS>Lap[I+1].GetS Then
Begin
    Csere(I,I+1);
    P:= Lap[I];
    Lap[I]:= Lap[I+1];
    Lap[I+1]:= P;
Szamol;
Delay(Emp);
End;
End;

Procedure JBuborek;
Var I: Byte;
VoltCsere: Boolean;
    P: TLap;
Begin
Sz:= 0;
While VoltCsere Do
Begin
VoltCsere:= False;
For I:= 0 To Db-1 Do
If Lap[I].GetS>Lap[I+1].GetS Then
Begin
VoltCsere:= True;
      Csere(I,I+1);
      P:= Lap[I];
      Lap[I]:= Lap[I+1];
      Lap[I+1]:= P;
Szamol;
End;
Delay(Emp);
End;
End;

Procedure Shell;
Var I, G: Byte;
VoltCsere: Boolean;
    P: TLap;
Begin
Sz:= 0;
  G:= (Db+1) Div 2;
Repeat
Repeat
VoltCsere:= False;
For I:=0 To Db-G Do
If Lap[I].GetS>Lap[I+G].GetS then
Begin
        Csere(I,I+G);
        P:= Lap[I];
        Lap[I]:= Lap[I+G];
        Lap[I+G]:= P;
VoltCsere:= True;
Szamol;
End;
Delay(Emp);
Until Not VoltCsere;
    G:= G Div 2;
Until G=0;
End;

Procedure Kivalasztas;
Var I, J: integer;
    P: TLap;
Lk, Lki: byte;
Begin
Sz:= 0;
  I:= -1;
While I<Db-1 Do
Begin
Lk:= Lap[I+1].GetS; Lki:= I+1;
For J:= I+1 To db Do If Lap[J].GetS<Lk Then
Begin
Lk:= Lap[J].GetS;
Lki:= J;
End;
If I+1<>Lki Then
Begin
      Csere(I+1,Lki);
      P:= Lap[I+1];
      Lap[I+1]:= Lap[Lki];
      Lap[Lki]:= P;
Szamol;
End;
    Inc(I);
Delay(Emp);
End;
End;

Procedure Beszuras;
Var I, J, K: Byte;
    P: TLap;
Begin
Sz:= 0;
For I:= 1 to Db do
Begin
Le(I);
    J:= I;

{Lineáris keresés}
While (J>0) And (Lap[J-1].GetS>Lap[I].GetS) Do

Begin
      Jobbra(J-1);
      Balra(I);
Dec(J);
Szamol;
End;
    Fel(I);
    P:= Lap[I];
For K:=I DownTo J Do Lap[K]:= Lap[K-1];
    Lap[J]:= P;
Delay(Emp);
End;
End;

Procedure JBeszuras;
Var I, J, K: Byte;
    P: TLap;
    Ah, Fh, M: Byte;
Begin
Sz:= 0;
For I:= 1 To Db Do
Begin
    Le(I); Ah:= 0; Fh:= I-1; J:= I;
if Lap[I].GetS<Lap[Fh].GetS Then
Begin
Repeat {Bináris keresés}
        M:= (Ah+Fh) Div 2;
If Lap[M].GetS>=Lap[I].GetS Then Fh:= M Else Ah:= M+1;
Until Ah=Fh;
While J>Fh do
Begin
Jobbra(J-1);
        Balra(I);
Dec(J);
Szamol;
End;
End;
    Fel(I); P:= Lap[I];
For K:=I DownTo J Do Lap[K]:= Lap[K-1];
    Lap[J]:= P;
delay(Emp);
End;
End;

Procedure Quick(Ki, Vi: Integer);
Var A, F :integer;
    K: integer;
    P: TLap;
Begin
  A:= Ki;
  F:= Vi;
  K:= Lap[(Ki+Vi) Div 2].GetS;
Repeat
While Lap[A].GetS<K Do Inc(A);
While Lap[F].GetS>K Do Dec(F);
If A<=F Then
Begin
If A<F Then
Begin
        Csere(A, F);
        P:= Lap[A];
        Lap[A]:= Lap[F];
        Lap[F]:= P;
Szamol;
Delay(Emp);
end;
      Inc(A);
Dec(F);
End;
Until A>F;
If KI<F Then Quick(Ki,F);
If A<Vi Then Quick(A,Vi);
End;

Begin
Szinek(1,0);
ClrScr;
ShowMouse;
InitEvents;
Mp:= 1;
Repeat
If Mp=0 Then Mp:= 1;
    Ablak(7,0,23,5,56,16,True,'Menü');
For I:= 1 To 10 Do WriteXY(25,5+I,MSor[I]);
Mp:= Menu(7,0,Green,25,6,30,10,Mp);
Case Mp Of
       1:Begin

Init; Keveres; Lapkepre; Varj;

CloseGraph; Kevert:=True

End;
       2:If Kevert Then
Begin
Init; Lapkepre; OutTextXY(180,10,'Közvetlen'); Varj;
Kozvetlen;

OutTextXY(240,400,'Kész'); Varj; CloseGraph;
End;
       3:If Kevert Then
Begin
Init; Lapkepre; OutTextXY(180,10,'Buborék'); Varj;
Buborek;

OutTextXY(240,400,'Kész'); Varj; CloseGraph;
End;
       4:If Kevert Then
Begin
Init; 

Lapkepre; OutTextXY(180,10,'Jav.Buborék'); Varj;
JBuborek;

OutTextXY(240,400,'Kész'); Varj; CloseGraph;
End;
       5:If Kevert Then
Begin
Init; Lapkepre; OutTextXY(180,10,'Shell'); Varj;
Shell; 

OutTextXY(240,400,'Kész'); Varj; CloseGraph;
End;
       6:If Kevert Then
Begin
Init; 

Lapkepre; OutTextXY(180,10,'Kiválasztás'); Varj;
Kivalasztas;

OutTextXY(240,400,'Kész'); Varj; CloseGraph;
End;
       7:If Kevert Then
Begin
Init; Lapkepre; OutTextXY(180,10,'Beszúrás'); Varj;
Beszuras;

OutTextXY(240,400,'Kész'); Varj; CloseGraph;
End;
       8:If Kevert Then
Begin
Init; 

Lapkepre; OutTextXY(180,10,'Jav.Beszúrás'); Varj;
JBeszuras; 

OutTextXY(240,400,'Kész'); Varj; CloseGraph;
End;
       9:If Kevert Then
Begin
Init; 

Lapkepre; OutTextXY(180,10,'Quick'); Varj; Sz:= 0;
Quick(0, Db);

OutTextXY(240,400,'Kész'); Varj; CloseGraph;
End;
      10:Begin Szinek(0,7); ClrScr; Halt End;
End;
Szinek(1,0); ClrScr;
ShowMouse;
Until False;
End.