unit USort;

interface

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

type
  TForm1 = class(TForm)
    mZahlenGeneriert: TMemo;
    mBubbleSort: TMemo;
    mInsertionSort: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    btnBubbleSort: TButton;
    btnInsertionSort: TButton;
    edZeitBubble: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    edZeitInsert: TEdit;
    Label6: TLabel;
    edDurchgaengeBubble: TEdit;
    edDurchgaengeInsert: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    Panel1: TPanel;
    btnZahlengenerieren: TButton;
    edAnzahl: TEdit;
    Label9: TLabel;
    Label10: TLabel;
    Panel2: TPanel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Button1: TButton;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    mQuickSort: TMemo;
    Label25: TLabel;
    mHeapSort: TMemo;
    Label26: TLabel;
    btnHeapSort: TButton;
    Label27: TLabel;
    Label28: TLabel;
    edZeitQuick: TEdit;
    Label29: TLabel;
    Label30: TLabel;
    edDurchgaengeQuick: TEdit;
    Label31: TLabel;
    edZeitHeap: TEdit;
    Label32: TLabel;
    Label33: TLabel;
    edDurchgaengeHeap: TEdit;
    btnQuickSort: TButton;
    procedure btnZahlengenerierenClick(Sender: TObject);
    procedure btnBubbleSortClick(Sender: TObject);
    procedure btnInsertionSortClick(Sender: TObject);
    procedure btnQuickSortClick(Sender: TObject);
    procedure btnHeapSortClick(Sender: TObject);
    procedure edAnzahlChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure HeapSort(var A: array of Integer);
    procedure QuickSort(var A: array of Integer);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  a: array[1..1000] of integer;
  b: array[1..1000] of integer;
  c: array[1..1000] of integer;
  d: array[1..1000] of integer;
  Zahl:integer;

implementation

{$R *.dfm}

procedure TForm1.btnZahlengenerierenClick(Sender: TObject);
var i: integer;
begin
mBubbleSort.Clear;
mInsertionSort.Clear;
mQuickSort.Clear;
mHeapSort.Clear;
mZahlenGeneriert.Clear;

Zahl:=strtoint(edAnzahl.text);

randomize();

for i := 1 to 1000 do
begin
a[i]:=random(Zahl+1);
b[i]:=a[i];
c[i]:=a[i];
d[i]:=a[i];
mZahlenGeneriert.lines.Add(inttostr(a[i]));
btnBubbleSort.Enabled:=true;
btnInsertionSort.Enabled:=true;
btnQuickSort.Enabled:=true;
btnHeapSort.Enabled:=true;
end;
end;

procedure TForm1.btnBubbleSortClick(Sender: TObject);
var d,n,k,i, speicher : integer;
           ZeitBubble: Cardinal;
begin
ZeitBubble:= GetTickCount;
d:= 0;
for k := 1 to 1000 do
    begin
    for n := 1 to 999 do
           begin
                if a[n] > a[n+1] then
                      begin
                      speicher:= a[n+1];
                      a[n+1]:= a[n];
                      a[n]:= speicher;
                      d:=d+1;
                      end;
            end;
    end;
    for i:= 1 to 1000 do mBubbleSort.Lines.Add(inttostr(a[i]));
    edZeitBubble.text:= IntToStr(GetTickCount - ZeitBubble);
    edDurchgaengeBubble.text:=IntToStr(d);
    btnBubbleSort.Enabled:= false;
end;


procedure TForm1.btnInsertionSortClick(Sender: TObject);
var e,i,j,v, p : Integer;
    ZeitInsert: Cardinal;
begin
ZeitInsert:= GetTickCount;
e:=0;
for i:= 1 to 1000 do begin

    if a[i] < a[i-1] then begin
      j := i;
      v := a[i];
      while (v < a[j-1]) AND (j > 0) do begin
        a[j] := a[j-1];
        dec(j);
      end;
      a[j] := v;
      e:=+1;
      end;
    edZeitInsert.text:= IntToStr(GetTickCount - ZeitInsert);
    end;
    for p:=1 to 1000 do mInsertionSort.Lines.Add(IntToStr(a[p]));
    edDurchgaengeInsert.Text:=InttoStr(e);
    btnInsertionSort.Enabled:= false;
end;

procedure TForm1.btnQuickSortClick(Sender: TObject);

  procedure QSort(LoIndex, HiIndex: Integer);
  var
    Lo, Hi: Integer;
    Pivot: Integer;
    Swap: Integer;
  begin
    // Wähle stets das mittlere Element als Pivot-Element
    Pivot := d[(LoIndex + HiIndex) div 2];

    // Stelle die Ordnung bzgl. des Pivot-Elements her
    Lo := LoIndex;
    Hi := HiIndex;
    repeat
      while d[Lo] < Pivot do Inc(Lo);
      while d[Hi] > Pivot do Dec(Hi);
      if Lo <= Hi then
      begin
        Swap := d[Lo];
        d[Lo] := d[Hi];
        d[Hi] := Swap;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;

    // ggf. linke Teilliste sortieren
    if LoIndex < Hi then QSort(LoIndex, Hi);

    // ggf. rechte Teilliste sortieren
    if Lo < HiIndex then QSort(Lo, HiIndex);
  end;

begin
  QSort(Low(d), High(d));
end;

procedure TForm1.btnHeapSortClick(Sender: TObject);
procedure HeapSort(var A: array of Integer);

  procedure Swap(var X, Y: Integer);
  var
    Swp: Integer;
  begin
    Swp := X;
    X := Y;
    Y := Swp;
  end;

  procedure SiftDown(Current, MaxIndex: Integer);
  var
    Left, Right, Largest: Integer;
  begin
    Left := Low(A) + (2 * (Current - Low(A))) + 1;
    Right := Low(A) + (2 * (Current - Low(A))) + 2;
    Largest := Current;
    if (Left <= MaxIndex) and (A[Left] > A[Largest]) then Largest := Left;
    if (Right <= MaxIndex) and (A[Right] > A[Largest]) then Largest := Right;
    if (Largest <> Current) then
    begin
      Swap(A[Current], A[Largest]);
      SiftDown(Largest, MaxIndex);
    end;
  end;

  procedure Heapify();
  var
    Middle: Integer;
    i: Integer;
  begin
    Middle := ((Low(A) + High(A) + 1) div 2) - 1;
    for i := Middle downto Low(A) do // Nur die Knoten, die Söhne haben!
      SiftDown(i, High(A));
  end;

var
  i: Integer;
begin
  Heapify();
  for i := High(A) downto Low(A) + 1 do
  begin
    Swap(A[i], A[Low(A)]);
    SiftDown(Low(A), i - 1);
  end;
end;

procedure TForm1.edAnzahlChange(Sender: TObject);
begin
if edAnzahl.text='' then
  begin
  MessageDlg('Bitte tragen Sie einen Höchstzahlenwert für die Zufallszahlen ein!',
  mtError, [mbOK], 0);
  edAnzahl.text:='1';
  end;
if ((strtoint(edAnzahl.text) < 1) or (strtoint(edAnzahl.text) > 1000)) then
  begin
  MessageDlg('Die Werte müssen zwischen "1" und "1000" liegen!',
  mtError, [mbOK], 0);
  edAnzahl.text :='1'
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var x: TForm;
begin
 x:= Dialogs.CreateMessageDialog('Möchten Sie das Programm wirklich beenden?', dialogs.mtConfirmation,
 dialogs.mbOKCancel);
 if x.ShowModal = mrOK then
 close;
end;

end.