unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls;
type
THashItem = class(TObject)
public
Key: string;
Next: THashItem;
end;
THashList = class(TObject)
private
FItems: array of THashItem;
function GetCount: Integer;
function GetItem(Index: Integer): THashItem;
public
constructor Create(Count: Integer);
destructor Destroy; override;
function CreateHash(AKey: string): Integer;
function Add(AKey: string): Boolean;
procedure Clear;
function Find(AKey: string): Integer;
property Count: Integer read GetCount;
property Items[Index: Integer]: THashItem read GetItem;
end;
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor THashList.Create(Count: Integer);
begin
inherited Create;
SetLength(FItems, Count);
end;
destructor THashList.Destroy;
begin
Clear;
Finalize(FItems);
inherited Destroy;
end;
//
function THashList.GetCount: Integer;
begin
result:=Length(FItems);
end;
function THashList.GetItem(Index: Integer): THashItem;
begin
if (Index>-1) and (Index<Length(FItems)) then
result:=FItems[Index]
else
result:=nil;
end;
//
function THashList.Add(AKey: string): Boolean;
var i: Integer;
Item: THashItem;
begin
i:=CreateHash(AKey);
if (i>-1) and (i<Length(FItems)) then
begin
if FItems[i]=nil then
begin
FItems[i]:=THashItem.Create;
FItems[i].Key:=AKey;
end;
Item:=FItems[i];
while Item.Key<>AKey do
begin
if Item.Next=nil then
begin
Item.Next:=THashItem.Create;
Item.Next.Key:=AKey;
end;
Item:=Item.Next;
end;
if Item.Key=AKey then
begin
result:=True;
Exit;
end
end;
result:=False;
end;
procedure THashList.Clear;
var i: Integer;
Item, Next: THashItem;
begin
for i:=0 to High(FItems) do
if FItems[i]<>nil then
begin
Item:=FItems[i];
while Item<>nil do
begin
Next:=Item.Next;
Item.Free;
Item:=Next;
end;
FItems[i]:=nil;
end;
end;
//
function THashList.Find(AKey: string): Integer;
var i: Integer;
Item: THashItem;
begin
i:=CreateHash(AKey);
if (i>-1) and (i<Length(FItems)) then
begin
Item:=FItems[i];
while (Item<>nil) and (Item.Key<>AKey) do
Item:=Item.Next;
if (Item<>nil) and (Item.Key=AKey) then
begin
result:=i;
Exit;
end;
end;
result:=-1;
end;
//
function THashList.CreateHash(AKey: string): Integer;
var i: Integer;
begin
result:=-1;
if Length(AKey)=0 then
Exit;
result:=ord(AKey[1]) mod Length(FItems);
for i:=2 to Length(AKey) do
result:=(result*128+ord(AKey[i])) mod Length(FItems);
end;
//
var
hl: THashList;
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
hl:=THashList.Create(50);
//ListeB
for i:=20 to 30 do
hl.Add('File'+IntToStr(i));
//ListeA
for i:=0 to 100 do
if hl.Find('File'+IntToStr(i))=-1 then
ListBox1.Items.Add('File'+IntToStr(i))
else
ListBox2.Items.Add('File'+IntToStr(i));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
hl.Free;
end;
end.
###
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 433
ClientWidth = 622
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
OnCreate = FormCreate
OnDestroy = FormDestroy
TextHeight = 15
object Label1: TLabel
Left = 32
Top = 24
Width = 32
Height = 15
Caption = 'ListeA'
end
object Label2: TLabel
Left = 247
Top = 24
Width = 31
Height = 15
Caption = 'ListeB'
end
object ListBox1: TListBox
Left = 32
Top = 56
Width = 209
Height = 329
ItemHeight = 15
TabOrder = 0
end
object ListBox2: TListBox
Left = 247
Top = 56
Width = 209
Height = 329
ItemHeight = 15
TabOrder = 1
end
end