ukeyclass.pas

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

   Result := -1;

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

   pd := DataList.Items [aIndex];

   Result := pd^.KeyValue;
end;

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

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

{
function TMultiStringKeyClass.Add (aKey : String; aKeyValue : Integer) : Boolean;
var
   nPos : Integer;
   pd : PTMultiStringKeyData;
begin
   Result := false;

   if Trim (aKey) = '' then exit;

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

   Sort;

   Result := true;
end;
}

function TMultiStringKeyClass.Insert (aKey : String; aKeyValue : Integer) : Boolean;
var
   i, nPos : Integer;
   pd : PTMultiStringKeyData;
begin
   Result := false;

   if Trim (aKey) = '' then exit;

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

   nPos := GetInsertPos (aKey);
   if nPos < 0 then exit;

   if nPos < DataList.Count then begin
      DataList.Insert (nPos, pd);
   end else begin
      DataList.Add (pd);
   end;

   Result := true;
end;


function TMultiStringKeyClass.Delete (aKey : String) : Boolean;
var
   i, nStartPos, nEndPos : Integer;
   pd : PTStringKeyData;
begin
   Result := false;

   if Select (aKey, nStartPos, nEndPos) > 0 then begin
      for i := nEndPos downto nStartPos do begin
         pd := DataList.Items [i];
         Dispose (pd);
         DataList.Delete (i);
      end;
   end;

   Result := true;
end;

function TMultiStringKeyClass.Select (aKey : String; var aStartPos, aEndPos : Integer) : Integer;
var
   i : Integer;
   nStartPos, nEndPos, HighPos, LowPos, MidPos : Integer;
   pd : PTStringKeyData;
begin
   Result := 0;

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

   aStartPos := -1; aEndPos := -1;
   nStartPos := -1; nEndPos := -1;
   while LowPos <= HighPos do begin
      pd := DataList.Items [MidPos];
      if pd^.StringKey = aKey then begin
         nStartPos :=  MidPos;
         nEndPos :=  MidPos;
         while nStartPos > 0 do begin
            pd := DataList.Items [nStartPos - 1];
            if pd^.StringKey <> aKey then break;
            Dec (nStartPos);
         end;
         while nEndPos < DataList.Count - 1 do begin
            pd := DataList.Items [nEndPos + 1];
            if pd^.StringKey <> aKey then break;
            Inc (nEndPos);
         end;
         aStartPos := nStartPos;
         aEndPos := nEndPos;
         Result := nEndPos - nStartPos + 1;
         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 TMultiStringKeyClass.GetInsertPos (aKey : String) : Integer;
var
   i : Integer;
   HighPos, LowPos, MidPos : Integer;
   pd : PTStringKeyData;
begin
   Result := 0;

   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
         while MidPos <= DataList.Count - 1 do begin
            pd := DataList.Items [MidPos];
            if pd^.StringKey <> aKey then break;
            Inc (MidPos);
         end;
         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;

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

   Result := MidPos;   
end;

// TIntegerKeyClass

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

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

   inherited Destroy;
end;

procedure TIntegerKeyClass.Clear;
var
   i : Integer;
   pd : PTIntegerKeyData;
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 TIntegerKeyClass.GetCount : Integer;
begin
   Result := DataList.Count;
end;

function TIntegerKeyClass.IndexOf (aKey : Integer) : Integer;
var
   i : Integer;
   HighPos, LowPos, MidPos : Integer;
   pd : PTIntegerKeyData;
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^.IntegerKey = aKey then begin
         Result := MidPos;
         exit;
      end else if pd^.IntegerKey > aKey then begin
         HighPos := MidPos - 1;
      end else begin
         LowPos := MidPos + 1;
      end;
      MidPos := (LowPos + HighPos) div 2;
   end;
end;

procedure TIntegerKeyClass.Sort;
begin
   DataList.Sort (IntegerKeyClassSortCompare);
end;

{
function TIntegerKeyClass.Add (aKey : Integer; aKeyValue : Pointer) : Boolean;
var
   pd : PTIntegerKeyData;
begin
   Result := false;

   if IndexOf (aKey) <> -1 then exit;

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

   Sort;

   Result := true;
end;
}

function TIntegerKeyClass.Insert (aKey : Integer; aKeyValue : Pointer) : Boolean;
var
   nPos : Integer;
   pd : PTIntegerKeyData;
begin
   Result := false;

   if IndexOf (aKey) <> -1 then exit;

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

   nPos := GetInsertPos (aKey);
   if nPos < 0 then exit;

   DataList.Insert (nPos, pd);

   Result := true;
end;

function TIntegerKeyClass.Delete (aKey : Integer) : Boolean;
var
   nIndex : Integer;
   pd : PTIntegerKeyData;
begin
   Result := false;

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

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

   DataList.Delete (nIndex);

   Result := true;
end;

function TIntegerKeyClass.Select (aKey : Integer) : Pointer;
var
   i : Integer;
   HighPos, LowPos, MidPos : Integer;
   pd : PTIntegerKeyData;
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^.IntegerKey = aKey then begin
         Result := pd^.KeyValue;
         exit;
      end else if pd^.IntegerKey > aKey then begin
         HighPos := MidPos - 1;
      end else begin
         LowPos := MidPos + 1;
      end;
      MidPos := (LowPos + HighPos) div 2;
   end;
end;

function TIntegerKeyClass.GetInsertPos (aKey : Integer) : Integer;
var
   i : Integer;
   HighPos, LowPos, MidPos : Integer;
   pd : PTIntegerKeyData;
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^.IntegerKey = aKey then begin
         exit;
      end else if pd^.IntegerKey > 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;


{
// TKeyList

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

destructor TKeyList.Destroy;
begin
   Clear;
   inherited Destroy;
end;

procedure TKeyList.Clear;
begin
   KeyData.Clear;
   DataList.Clear;
end;

function TKeyList.Get (aIndex : Integer) : Pointer;
begin
   Result := nil;
   if aIndex < DataList.Count then begin
      Result := DataList.Items [aIndex];
   end;
end;

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

function TKeyList.Add (aKey : String; aData : Pointer) : Boolean;
begin
   Result := false;
   if KeyData.Add (aKey, DataList.Count) = true then begin
      DataList.Add (aData);
      Result := true;
   end;
end;

procedure TKeyList.Delete (aKey : String);
var
   nIndex : Integer;
begin
   nIndex := KeyData.Select (aKey);
   if KeyData.Delete (aKey) = true then begin
      DataList.Delete (nIndex);
   end;
end;

function TKeyList.Find (aKey : String) : Pointer;
var
   nIndex : Integer;
begin
   Result := nil;

   nIndex := KeyData.Select (aKey);
   if nIndex >= 0 then begin
      Result := Get (nIndex);
   end;
end;
}

end.