Homepage von Thomas Schwobe
Home Software Quelltext Impressum Datenschutzerklärung

Quelltext:

unit FormatHash;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics;

type
  TFormatHashItem = class(TObject)
  public
    Key: string;

    Next: TFormatHashItem;
  end;
  
  TFormatHashList = class(TObject)
  private
    FItems: array of TFormatHashItem;

    function GetCount: Integer;
    function GetKey(AKey: string): Integer;

    function CreateHash(AKey: string): Integer;
  public
    constructor Create(Count: Integer);
    destructor Destroy; override;

    function Add(AKey: string): Boolean;
    procedure Delete(AKey: string);
    procedure Clear;

    property Count: Integer read GetCount;
    property Keys[AKey: string]: Integer read GetKey; default;
  end;

implementation

constructor TFormatHashList.Create(Count: Integer);
begin
  inherited Create;

  SetLength(FItems, Count);
end;

destructor TFormatHashList.Destroy;
begin
  Clear;
  
  Finalize(FItems);

  inherited Destroy;
end;

//

function TFormatHashList.GetCount: Integer;
begin
  result:=Length(FItems);
end;

function TFormatHashList.GetKey(AKey: string): Integer;
var i: Integer;

    Item: TFormatHashItem;

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 TFormatHashList.Add(AKey: string): Boolean;
var i: Integer;

    Item: TFormatHashItem;

begin
  i:=CreateHash(AKey);

  if (i>-1) and (i<Length(FItems)) then
  begin
    if FItems[i]=nil then
    begin
      FItems[i]:=TFormatHashItem.Create;
      FItems[i].Key:=AKey;
    end;

    Item:=FItems[i];

    while Item.Key<>AKey do
    begin
      if Item.Next=nil then
      begin
        Item.Next:=TFormatHashItem.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 TFormatHashList.Delete(AKey: string);
var i: Integer;

    Last, Item, Next: TFormatHashItem;

begin
  i:=CreateHash(AKey);

  if (i>-1) and (i<Length(FItems)) then
  begin
    Last:=nil;
    Item:=FItems[i];

    while (Item<>nil) and (Item.Key<>AKey) do
    begin
      Last:=Item;
      Item:=Item.Next;
    end;

    if (Item<>nil) and (Item.Key=AKey) then
    begin
      if Last=nil then
      begin
        Next:=Item.Next;
        Item.Free;
        Item:=Next;
      end
      else
      begin
        Last.Next:=Item.Next;
        Item.Free;
      end;
    end
  end;
end;

procedure TFormatHashList.Clear;
var i: Integer;

    Item, Next: TFormatHashItem;

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 TFormatHashList.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;

end.

© 2025 by Thomas Schwobe