PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/ClassDict.pas

Pascal/Delphi Source File | 1997-05-02 | 5.4 KB | 281 lines

unit ClassDict;



interface



uses

    // Start user include section

    // End user include section

    Classes;



type

    TClassDictElem = class

    private

        // User defined attributes

        obj: Pointer;

        key: Variant;



    published

        // User defined methods

        constructor Create;

        destructor Destroy; override;



        // Access methods

        function getKey: Variant;

        procedure setObj(newObj: Pointer);

        procedure setKey(newKey: Variant);

        function getObj: Pointer;

    end;





    TClassDict = class

    private

        // Association attributes

        elemSet: TList;

    published

        // User defined methods

        constructor Create;

        destructor Destroy; override;

        procedure Remove(obj: Pointer);

        function Count: Integer;

        procedure RemoveUsingKey(key: Variant);

        function FirstKey: Variant;

        function Last: Pointer;

        function Item(key: Variant): Pointer;

        procedure Add(key: Variant; obj: Pointer);

        function First: Pointer;

        function LastKey: Variant;



        // Access methods

        procedure addElem(newTClassDictElem: TClassDictElem);

        function getElem: TList;

        procedure removeElem(oldTClassDictElem: TClassDictElem);

    end;





implementation



constructor TClassDictElem.Create;

    // Start user section

    // End user section

begin

    inherited Create;



    // Start user section

    // End user section

end;





destructor TClassDictElem.Destroy;

    // Start user section

    // End user section

begin

    // Start user section

    // End user section

    inherited Destroy;

end;



function TClassDictElem.getKey: Variant;

begin

    getKey := key;

end;





procedure TClassDictElem.setObj(newObj: Pointer);

begin

    obj := newObj;

end;





procedure TClassDictElem.setKey(newKey: Variant);

begin

    key := newKey;

end;





function TClassDictElem.getObj: Pointer;

begin

    getObj := obj;

end;







constructor TClassDict.Create;

    // Start user section

    // End user section

begin

    inherited Create;



    elemSet := TList.Create;

    // Start user section

    // End user section

end;





destructor TClassDict.Destroy;

    // Start user section

    // End user section

begin

    // Start user section

    // End user section

    elemSet.Destroy;

    inherited Destroy;

end;





procedure TClassDict.Remove(obj: Pointer);

var

    tmpElem: TClassDictElem;

    Index: integer;

    NrOfElems: integer;

        Found: boolean;



begin

    NrOfElems := elemSet.Count;

    Index := 0;

    Found := False;

    while (Index <> NrOfElems) and (not(Found)) do

    begin

        tmpElem := elemSet.Items[Index];

        if tmpElem.getObj() = obj then

        begin

            removeElem(tmpElem);

            tmpElem.Destroy();

            Found := True;

        end;

                inc(Index);

    end;

end;





function TClassDict.Count: Integer;

begin

    Count := elemSet.Count;

end;





procedure TClassDict.RemoveUsingKey(key: Variant);

var

    tmpElem: TClassDictElem;

    Index: integer;

    NrOfElems: integer;

    Found: boolean;



begin

    NrOfElems := elemSet.Count;

    Index := 0;

        Found := False;

    while (Index <> NrOfElems) and (not(Found)) do

    begin

        tmpElem := elemSet.Items[Index];

        if (tmpElem.getKey() = key) then

        begin

            removeElem(tmpElem);

            tmpElem.Destroy();

            Found := True;

        end;

                inc(Index);

    end;

end;





function TClassDict.FirstKey: Variant;

var

    tmpElem: TClassDictElem;



begin

    tmpElem := elemSet.First();

    FirstKey := tmpElem.getKey();

end;





function TClassDict.Last: Pointer;

var

    tmpElem: TClassDictElem;



begin

    tmpElem := elemSet.Last();

    Last := tmpElem.getObj();

end;





function TClassDict.Item(key: Variant): Pointer;

var

    tmpElem: TClassDictElem;

    Index: integer;

    NrOfElems: integer;

    Found: boolean;



begin

    NrOfElems := elemSet.Count;

    Index := 0;

    Found := False;

    while (Index <> NrOfElems) and (not(Found)) do

    begin

        tmpElem := elemSet.Items[Index];

        if (tmpElem.getKey() = key) then

        begin

            Item := tmpElem.getObj();

            Found := True;

        end;

                inc(Index);

    end;

    if not(Found) then

           Item := NIL;

end;





procedure TClassDict.Add(key: Variant; obj: Pointer);

var

    tmpElem: TClassDictElem;



begin

    tmpElem := TClassDictElem.Create;

    tmpElem.setKey(key);

    tmpElem.setObj(obj);

    addElem(tmpElem);

end;





function TClassDict.First: Pointer;

var

    tmpElem: TClassDictElem;



begin

    tmpElem := elemSet.First;

    First := tmpElem.getObj;

end;





function TClassDict.LastKey: Variant;

var

    tmpElem: TClassDictElem;



begin

    tmpElem := elemSet.Last;

    LastKey := tmpElem.getKey;

end;





procedure TClassDict.addElem(newTClassDictElem: TClassDictElem);

begin

    if (elemSet.IndexOf(newTClassDictElem) = -1) then

    begin

        elemSet.Add(newTClassDictElem);

    end;

end;





function TClassDict.getElem: TList;

begin

    getElem := elemSet;

end;





procedure TClassDict.removeElem(oldTClassDictElem: TClassDictElem);

begin

    elemSet.Remove(oldTClassDictElem);

end;





end.