Skip to content

Instantly share code, notes, and snippets.

@DasLampe
Created June 15, 2009 19:13
Show Gist options
  • Save DasLampe/130275 to your computer and use it in GitHub Desktop.
Save DasLampe/130275 to your computer and use it in GitHub Desktop.
unit Unit12;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
Tmain = class(TForm)
LBoxDemo: TListBox;
BtFuellen: TButton;
BtBubble: TButton;
BtInsert: TButton;
BtShell: TButton;
BtSuche: TButton;
EdStart: TEdit;
EdEnde: TEdit;
EdAnz: TEdit;
EdSuchwort: TEdit;
procedure BtFuellenClick(Sender: TObject);
procedure BtBubbleClick(Sender: TObject);
procedure BtInsertClick(Sender: TObject);
procedure BtShellClick(Sender: TObject);
procedure BtSucheClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
main: Tmain;
implementation
{$R *.dfm}
procedure Tmain.BtFuellenClick(Sender: TObject);
var i, anz : integer;
begin
randomize;
i := 0;
anz := StrToInt(EdAnz.Text);
LBoxDemo.clear;
repeat
LBoxDemo.Items.add(IntToSTr(random(10000)));
i := i + 1;
until i = anz;
end;
procedure Tmain.BtBubbleClick(Sender: TObject);
var i, j : integer;
str : string;
getauscht : boolean;
begin
EdStart.Text := TimeToStr(time); // Startzeit anzeigen
j := LBoxDemo.Items.count - 1; // Bubblesort
repeat
i := 0;
getauscht := false;
repeat
if LBoxDemo.Items[i] > LBoxDemo.Items[i+1] then
begin
getauscht := true;
str := LBoxDemo.Items[i];
LBoxDemo.Items[i] := LBoxDemo.Items[i+1];
LBoxDemo.items[i+1] := str;
end;
i := i + 1;
until i >= j;
j := j - 1;
until (j = 0) or not getauscht;
EdEnde.Text := TimeToStr(time); // Sortierende-Zeitpunkt anzeigen
end;
procedure Tmain.BtInsertClick(Sender: TObject);
var i, j : integer;
str : string;
begin
EdStart.Text := TimeToStr(time);
i := 1;
repeat // Insertionsort
str := LBoxDemo.Items[i];
j := i;
while (j > 0) and (LBoxDemo.Items[j-1] > str) do
begin
LBoxDemo.Items[j] := LBoxDemo.Items[j-1];
j := j - 1;
end;
LBoxDemo.Items[j] := str;
i := i + 1;
until i >= LBoxDemo.Items.Count;
EdEnde.Text := TimeToStr(time);
end;
procedure Tmain.BtShellClick(Sender: TObject);
var i, j, h : integer;
str : string;
begin
EdStart.Text := TimeToStr(time);
h := 1; // Shell-Sort
repeat
h := 3 * h + 1;
until h > LBoxDemo.Items.Count - 1;
repeat
h := h div 3;
for i := h to (LBoxDemo.Items.Count - 1) do
begin
str := LBoxDemo.Items[i];
j := i;
while ((j >= h) and (LBoxDemo.Items[j-h] > str)) do
begin
LBoxDemo.Items[j] := LBoxDemo.Items[j-h];
j := j - h;
end;
LBoxDemo.Items[j] := str;
end;
until h <= 1;
EdEnde.Text := TimeToStr(time);
end;
procedure Tmain.BtSucheClick(Sender: TObject);
var m,a,e:integer;
gefunden: boolean;
begin
a:=0;
e:=LBoxDemo.Items.Count -1;
gefunden:=false;
repeat
m:=(a+e) div 2;
if EdSuchwort.Text < LBoxDemo.Items[m] then e:=m
else if EdSuchwort.Text > LBoxDemo.Items[m] then a:=m+1
else if EdSuchwort.Text = LBoxDemo.Items[m] then gefunden:=true;
until (a >= e) OR (gefunden = true);
if gefunden = true then
LBoxDemo.itemindex:=m
else
ShowMessage('Nichts gefunden');
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment