unit uSortieren;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls,Math, ExtCtrls;
type
TForm1 =
class(TForm)
MainMenu1: TMainMenu;
Memo1: TMemo;
Memo2: TMemo;
Datei1: TMenuItem;
Laden1: TMenuItem;
Speichern1: TMenuItem;
Schlieen1: TMenuItem;
Sortieren1: TMenuItem;
Heapsort1: TMenuItem;
Mergesort1: TMenuItem;
Sehllsort1: TMenuItem;
Neu1: TMenuItem;
Extras1: TMenuItem;
Zufallszahlen1: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Memolschen1: TMenuItem;
procedure Sehllsort1Click(Sender: TObject);
procedure Laden1Click(Sender: TObject);
procedure Speichern1Click(Sender: TObject);
procedure Neu1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
a :
array of integer;
const hoehe = 200;
implementation
{$R *.dfm}
procedure Delay(dwMilliseconds: Longint);
var
iStart, iStop: DWORD;
begin
iStart := GetTickCount;
repeat
iStop := GetTickCount;
Application.ProcessMessages;
until (iStop-iStart) >= dwMilliseconds;
end;
procedure ZeichneVisu(a :
array of integer);
var
i :integer;
begin
with Form1.Image1
do
begin
Canvas.Brush.Color := clWhite;
Canvas.Rectangle(0,0,Width,height);
Canvas.Brush.Color := clSkyBlue;
for i := 1
to length(a)
do
begin
Canvas.Rectangle((i-1)*18+3,Height-ceil(Height/(Hoehe/a[i]))+2,(i-1)*18+13,Height);
end;
end;
end;
procedure ShellSort(
var aSort:
array of integer);
var
iI, iJ, iK,
iSize: integer;
wTemp: integer;
begin
iSize := High(aSort);
iK := iSize
shr 1;
while iK > 0
do
begin
for iI := 0
to iSize - iK
do
begin
iJ := iI;
while (iJ >= 0)
and (aSort[iJ] > aSort[iJ + iK])
do
begin
wTemp := aSort[iJ];
aSort[iJ] := aSort[iJ + iK];
aSort[iJ + iK] := wTemp;
if iJ > iK
then
Dec(iJ, iK)
else
iJ := 0 ;
ZeichneVisu(a);
Delay(50);
end;
end;
iK := iK
shr 1;
end;
end;
procedure TForm1.Speichern1Click(Sender: TObject);
begin
if saveDialog1.execute
then begin
memo1.Lines.savetofile(saveDialog1.filename);
end;
end;
procedure TForm1.Sehllsort1Click(Sender: TObject);
var
i : integer;
begin
SetLength(a,Memo1.Lines.Count);
for i := 0
to Memo1.Lines.Count -1
do a[i] := strtoint(Memo1.Lines[i]);
ShellSort(a);
for i := 0
to high(a)
do Memo2.Lines.Add(inttostr(a[i]));
end;
procedure TForm1.Laden1Click(Sender: TObject);
begin
if openDialog1.execute
then begin
memo1.Lines.loadfromfile(openDialog1.filename);
end;
end;
procedure TForm1.Neu1Click(Sender: TObject);
begin
memo1.lines.Clear;
memo2.lines.Clear;
end;
end.