gistfile1.pas

unit suchen;

interface

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

type
  Tmain = class(TForm)
    lb_liste: TListBox;
    bt_search: TButton;
    ed_search: TEdit;
    procedure bt_searchClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    procedure search(anfang, ende: integer);
    procedure sort();
  end;

var
  main: Tmain;

implementation

uses Math;

{$R *.dfm}

procedure Tmain.bt_searchClick(Sender: TObject);
begin
  search(0, lb_liste.Items.Count);
end;

procedure Tmain.sort();
var h, i, j: integer; str: string;
begin
  h := 1;                                 // Shell-Sort
  repeat
    h := 3 * h + 1;
  until h > lb_liste.Items.Count - 1;

  repeat
    h := h div 3;
    for i := h to (lb_liste.Items.Count - 1) do
      begin
        str := lb_liste.Items[i];
        j := i;
        while ((j >= h) and (lb_liste.Items[j-h] > str)) do
          begin
            lb_liste.Items[j] := lb_liste.Items[j-h];
            j := j - h;
          end;
          lb_liste.Items[j] := str;
      end;
  until h <= 1;
end;

procedure Tmain.search(anfang, ende: integer);
var mitte:integer;
  gefunden: bool;
begin
  gefunden := false;

  //Ausrechnen der Mitte
  mitte   := (anfang + ende) div 2;

  //Überprüfe ob String > oder kleiner < von Itemsstring
  if lb_liste.Items[mitte] < ed_search.Text then
    anfang  := mitte+1
  else if lb_liste.Items[mitte] > ed_search.Text then
    ende    := mitte
  else
    gefunden := true;

  if anfang >= ende then
    ShowMessage('Nichts gefunden')
  else if gefunden = false AND NOT (anfang >= ende) then
    begin
      search(anfang, ende);
    end
  else
    begin
      lb_liste.ItemIndex := mitte;
      ShowMessage(IntToStr(mitte +1));
    end;
end;

procedure Tmain.FormCreate(Sender: TObject);
begin
  sort();
end;

end.