Einzelnen Beitrag anzeigen

qwertz543221
(Gast)

n/a Beiträge
 
#6

Re: LZW Komprimierung für texte - zugriffsverletzung

  Alt 21. Aug 2009, 14:52
Delphi-Quellcode:
unit Unit1;

interface

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

type
dd=record
zahl:longint;
s:string;
end;
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Edit3: TEdit;
    Label3: TLabel;
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure write;
    procedure init;
    procedure Quicksort ( l,r: longint);
    function BinSearch(a: array of longint; x: longint): longint;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  ar:array of longint;

implementation

{$R *.dfm}

function tform1.BinSearch(a: array of longint; x: longint): longint;
var
  anfang,ende,pivot:longint;
  fund:Boolean;
begin
if x>a[length(a)-1]
  then
  begin
  result:=-1;
  exit;
  end
  else
  begin
  anfang:= 0;
  ende:= length(a);
  fund:= False;
  Result := -1;

  while anfang<= ende) and (found=false) do
  begin
    Pivot := ((anfang + ende) div 2)mod length(a);
    if a[Pivot] = x then
    begin
      Found := True;
      Result := Pivot+1;
    end
    else if a[Pivot] > x then
      ende := Pivot - 1
    else
      anfang := Pivot + 1;
  end;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
i,j,x,max:longint;
begin
memo1.Clear;
max:=strtoint(edit1.text);
i:=strtoint(edit2.Text);
setlength(ar,i);
randomize;
j:=0;
while j<i do
begin
x:=random(max)+1;
ar[j]:=x;
memo1.Lines.Add(inttostr(ar[j]));
j:=j+1;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
memo1.Clear;
edit1.Clear;
edit2.Clear;
end;

procedure tform1.init;
var i:longint;
begin
i:=0;
setlength(ar,strtoint(edit2.text));
while i<length(ar) do
begin
ar[i]:=(strtoint(memo1.Lines[i]));
i:=i+1;
end;
end;


procedure tform1.write;
var i:longint;
 begin
 i:=0;
 memo1.Clear;
while i<length(ar) do
begin
memo1.Lines.add(inttostr(ar[i]));
i:=i+1;
end;
end;

PROCEDURE tform1.Quicksort (l,r: longint);
VAR pivot,b,i,j : longint;

BEGIN
   IF l < r THEN
   BEGIN
      pivot := Ar[random(r-l) + l+1];
      i := l-1;
      j := r+1;
         while i<j do
         begin
      REPEAT i := i+1 UNTIL pivot <= ar[i];
      //while (pivot>ar[i])do i:=i+1;
            REPEAT j := j-1 UNTIL pivot >= ar[j];
            b:=Ar[i];
            Ar[i]:=Ar[j];
            Ar[j]:=b
      //UNTIL i >= j;
      end;

      Ar[j]:=Ar[i];
      Ar[i]:=b;

      Quicksort(l,i-1);
      Quicksort(i,r)
   END;
END;



procedure TForm1.Button2Click(Sender: TObject);
var s,t:cardinal;
begin
s:=gettickcount;
init;
bubblesort;
t:=gettickcount;
showmessage(inttostr(t-s));
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
edit2.Text:=inttostr(memo1.lines.Count);
end;

procedure TForm1.Button4Click(Sender: TObject);
var s,t:cardinal;
begin
s:=gettickcount;
init;
quicksort(0,length(ar));;
t:=gettickcount;
showmessage(inttostr(t-s));
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
write;
end;

procedure TForm1.Button6Click(Sender: TObject);
var x:longint;
begin
x:=strtoint(edit3.Text);
init;
quicksort(0,length(ar));
showmessage(inttostr(binsearch(ar,x)));
end;

end.
  Mit Zitat antworten Zitat