ukeyclass.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

unit uKeyClass;

interface

uses
   Windows, Classes, SysUtils;

type

   TStringKeyData = record
      StringKey : String [64 - 1];
      KeyValue : Pointer;
   end;
   PTStringKeyData = ^TStringKeyData;

   TIntegerKeyData = record
      IntegerKey : Integer;
      KeyValue : Pointer;
   end;
   PTIntegerKeyData = ^TIntegerKeyData;

   TMultiStringKeyData = record
      StringKey : String [64 - 1];
      KeyValue : Integer;
   end;
   PTMultiStringKeyData = ^TMultiStringKeyData;

   TStringKeyClass = class
   private
      DataList : TList;

      function IndexOf (aKey : String) : Integer;
      function GetCount : Integer;
      function GetInsertPos (aKey : String) : Integer;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Clear;

      procedure Sort;

      // function Add (aKey : String; aKeyValue : Pointer) : Boolean;
      function Insert (aKey : String; aKeyValue : Pointer) : Boolean;
      function Delete (aKey : String) : Boolean;
      function Select (aKey : String) : Pointer;

      // function GetKey (aIndex : Integer) : String;

      property Count : Integer read GetCount;
   end;

   TIntegerKeyClass = class
   private
      DataList : TList;

      function IndexOf (aKey : Integer) : Integer;
      function GetCount : Integer;
      function GetInsertPos (aKey : Integer) : Integer;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Clear;

      procedure Sort;

      // function Add (aKey : Integer; aKeyValue : Pointer) : Boolean;
      function Insert (aKey : Integer; aKeyValue : Pointer) : Boolean;
      function Delete (aKey : Integer) : Boolean;
      function Select (aKey : Integer) : Pointer;

      property Count : Integer read GetCount;
   end;

   TMultiStringKeyClass = class
   private
      DataList : TList;

      function GetCount : Integer;
      function GetInsertPos (aKey : String) : Integer;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Clear;

      procedure Sort;

      // function Add (aKey : String; aKeyValue : Integer) : Boolean;
      function Insert (aKey : String; aKeyValue : Integer) : Boolean;
      function Delete (aKey : String) : Boolean;
      function Select (aKey : String; var aStartPos, aEndPos : Integer) : Integer;

      function GetKeyString (aIndex : Integer) : String;
      function GetKeyValue (aIndex : Integer) : Integer;

      property Count : Integer read GetCount;
   end;


   {
   TKeyList = class
   private
      KeyData : TStringKeyClass;
      DataList : TList;

      function Get (aIndex : Integer) : Pointer;
      function GetCount : Integer;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Clear;

      function Add (aKey : String; aData : Pointer) : Boolean;
      procedure Delete (aKey : String);
      function Find (aKey : String) : Pointer;

      property Count : Integer read GetCount;
      property Items [aIndex : Integer] : Pointer read Get;
   end;
   }

   function StringKeyClassSortCompare (Item1, Item2: Pointer): Integer;
   function IntegerKeyClassSortCompare (Item1, Item2: Pointer): Integer;

implementation

function StringKeyClassSortCompare (Item1, Item2: Pointer): Integer;
var
   pd1, pd2 : PTStringKeyData;
begin
   Result := 0;

   pd1 := PTStringKeyData (Item1);
   pd2 := PTStringKeyData (Item2);

   if pd1^.StringKey > pd2^.StringKey then begin
      Result := 1;
   end else if pd1^.StringKey < pd2^.StringKey then begin
      Result := -1;
   end;
end;

function IntegerKeyClassSortCompare (Item1, Item2: Pointer): Integer;
var
   pd1, pd2 : PTIntegerKeyData;
begin
   Result := 0;

   pd1 := PTIntegerKeyData (Item1);
   pd2 := PTIntegerKeyData (Item2);

   if pd1^.IntegerKey > pd2^.IntegerKey then begin
      Result := 1;
   end else if pd1^.IntegerKey < pd2^.IntegerKey then begin
      Result := -1;
   end;
end;

// TStringKeyClass

constructor TStringKeyClass.Create;
begin
   DataList := TList.Create;
end;

destructor TStringKeyClass.Destroy;
begin
   Clear;
   DataList.Free;

   inherited Destroy;
end;

procedure TStringKeyClass.Clear;
var
   i : Integer;
   pd : PTStringKeyData;
begin
   for i := 0 to DataList.Count - 1 do begin
      pd := DataList.Items [i];
      if pd <> nil then Dispose (pd);
   end;
   DataList.Clear;
end;

function TStringKeyClass.IndexOf (aKey : String) : Integer;
var
   i : Integer;
   HighPos, LowPos, MidPos : Integer;
   pd : PTStringKeyData;
begin
   Result := -1;

   LowPos := 0;
   HighPos := DataList.Count - 1;
   MidPos := (LowPos + HighPos) div 2;

   while LowPos <= HighPos do begin
      pd := DataList.Items [MidPos];
      if pd^.StringKey = aKey then begin
         Result := MidPos;
         exit;
      end else if pd^.StringKey > aKey then begin
         HighPos := MidPos - 1;
      end else begin
         LowPos := MidPos + 1;
      end;
      MidPos := (LowPos + HighPos) div 2;
   end;
end;


{
function TStringKeyClass.GetKey (aIndex : Integer) : String;
var
   i : Integer;
   pd : PTStringKeyData;
begin
   Result := '';
   for i := 0 to DataList.Count - 1 do begin
      pd := DataList.Items [i];
      if pd^.KeyValue = aIndex then begin
         Result := pd^.StringKey;
         exit;
      end;
   end;
end;
}

function TStringKeyClass.GetCount : Integer;
begin
   Result := DataList.Count;
end;

procedure TStringKeyClass.Sort;
begin
   DataList.Sort (StringKeyClassSortCompare);
end;

{
function TStringKeyClass.Add (aKey : String; aKeyValue : Pointer) : Boolean;
var
   pd : PTStringKeyData;
   p : Pointer;
begin
   Result := false;

   if Trim (aKey) = '' then exit;

   p := Select (aKey);
   if p <> nil then exit;

   New (pd);
   pd^.StringKey := aKey;
   pd^.KeyValue := aKeyValue;
   DataList.Add (pd);

   Result := true;
end;
}

function TStringKeyClass.Insert (aKey : String; aKeyValue : Pointer) : Boolean;
var
   nPos : Integer;
   pd : PTStringKeyData;
   p : Pointer;
begin
   Result := false;

   if Trim (aKey) = '' then exit;

   p := Select (aKey);
   if p <> nil then exit;

   New (pd);
   pd^.StringKey := aKey;
   pd^.KeyValue := aKeyValue;

   nPos := GetInsertPos (aKey);
   if nPos < 0 then exit;
   
   DataList.Insert (nPos, pd);

   Result := true;
end;

function TStringKeyClass.Delete (aKey : String) : Boolean;
var
   nPos : Integer;
   pd : PTStringKeyData;
begin
   Result := false;

   nPos := IndexOf (aKey);
   if (nPos < 0) or (nPos >= DataList.Count) then exit;

   pd := DataList.Items [nPos];
   Dispose (pd);

   DataList.Delete (nPos);

   Result := true;
end;

function TStringKeyClass.Select (aKey : String) : Pointer;
var
   i : Integer;
   HighPos, LowPos, MidPos : Integer;
   pd : PTStringKeyData;
begin
   Result := nil;

   LowPos := 0;
   HighPos := DataList.Count - 1;
   MidPos := (LowPos + HighPos) div 2;

   while LowPos <= HighPos do begin
      pd := DataList.Items [MidPos];
      if pd^.StringKey = aKey then begin
         Result := pd^.KeyValue;
         exit;
      end else if pd^.StringKey > aKey then begin
         HighPos := MidPos - 1;
      end else begin
         LowPos := MidPos + 1;
      end;
      MidPos := (LowPos + HighPos) div 2;
   end;
end;

function TStringKeyClass.GetInsertPos (aKey : String) : Integer;
var
   i : Integer;
   HighPos, LowPos, MidPos : Integer;
   pd : PTStringKeyData;
begin
   Result := -1;
   
   LowPos := 0;
   HighPos := DataList.Count - 1;
   MidPos := (LowPos + HighPos) div 2;

   while LowPos <= HighPos do begin
      pd := DataList.Items [MidPos];
      if pd^.StringKey = aKey then begin
         exit;
      end else if pd^.StringKey > aKey then begin
         HighPos := MidPos - 1;
      end else begin
         LowPos := MidPos + 1;
      end;
      MidPos := (LowPos + HighPos) div 2;
   end;

   if HighPos >= 0 then MidPos := MidPos + 1;

   Result := MidPos;
end;

// TMultiStringKeyClass

constructor TMultiStringKeyClass.Create;
begin
   DataList := TList.Create;
end;

destructor TMultiStringKeyClass.Destroy;
begin
   Clear;
   DataList.Free;

   inherited Destroy;
end;

procedure TMultiStringKeyClass.Clear;
var
   i : Integer;
   pd : PTStringKeyData;
begin
   for i := 0 to DataList.Count - 1 do begin
      pd := DataList.Items [i];
      if pd <> nil then Dispose (pd);
   end;
   DataList.Clear;
end;

function TMultiStringKeyClass.GetKeyString (aIndex : Integer) : String;
var
   pd : PTStringKeyData;
begin
   Result := '';

   if (aIndex < 0) or (aIndex >= DataList.Count) then exit;

   pd := DataList.Items [aIndex];

   Result := pd^.StringKey;
end;

function TMultiStringKeyClass.GetKeyValue (aIndex : Integer) : Integer;
var
   pd : PTMultiStringKeyData;
begin