mmmrklst.pas

一套及时通讯的原码

procedure TMMMarkerList.Insert(Index: Integer; Marker: TMMMarker);
begin
   if (Index < 0) or (Index > FCount) then Error;
   Changing;
   if FCount = FCapacity then Grow;
   if Index < FCount then
      System.Move(FList^[Index], FList^[Index + 1],
                 (FCount - Index) * SizeOf(TMMMarker));
   FList^[Index] := Marker;
   Inc(FCount);
   Changed;
end;

{-- TMMMarkerList --------------------------------------------------------}
function TMMMarkerList.Last: PMMMarker;
begin
   Result := Get(FCount-1);
end;

{-- TMMMarkerList --------------------------------------------------------}
procedure TMMMarkerList.Move(CurIndex, NewIndex: Integer);
var
  Marker: TMMMarker;
begin
   if CurIndex <> NewIndex then
   begin
      if (NewIndex < 0) or (NewIndex >= FCount) then Error;
      Marker := Get(CurIndex)^;
      Delete(CurIndex);
      Insert(NewIndex, Marker);
   end;
end;

{-- TMMMarkerList --------------------------------------------------------}
procedure TMMMarkerList.Put(Index: Integer; Marker: PMMMarker);
begin
   if (Index < 0) or (Index >= FCount) then Error;
   Changing;
   FList^[Index] := Marker^;
   Changed;
end;

{-- TMMMarkerList --------------------------------------------------------}
function TMMMarkerList.Remove(Marker: PMMMarker): Integer;
begin
   Result := IndexOf(Marker);
   if Result <> -1 then Delete(Result);
end;

{-- TMMMarkerList --------------------------------------------------------}
procedure TMMMarkerList.SetCapacity(NewCapacity: Integer);
begin
   if (NewCapacity < FCount) or (NewCapacity > MaxListSize) then Error;

   if NewCapacity <> FCapacity then
   begin
     {$IFDEF WIN32}
     ReallocMem(FList, NewCapacity * SizeOf(TMMMarker));
     {$ELSE}
     if NewCapacity = 0 then
     begin
        GlobalFreeMem(FList);
        FList := nil;
     end
     else
     begin
        if FCapacity = 0 then
           FList := GlobalAllocPtr(HeapAllocFlags, NewCapacity*sizeOf(TMMMarker))
        else
           FList := GlobalReallocPtr(FList, NewCapacity*sizeOf(TMMMarker), HeapAllocFlags);
        if FList = nil then
           raise EStreamError.Create(LoadStr(SMemoryStreamError));
     end;
     {$ENDIF}
     FCapacity := NewCapacity;
   end;
end;

{-- TMMMarkerList --------------------------------------------------------}
procedure TMMMarkerList.SetCount(NewCount: Integer);
begin
   if (NewCount < 0) or (NewCount > MaxListSize) then Error;

   if NewCount > FCapacity then SetCapacity(NewCount);
   if NewCount > FCount then
      FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(TMMMarker), 0);
   FCount := NewCount;
end;

{-- TMMMarkerList --------------------------------------------------------}
procedure TMMMarkerList.SetOffset(Index: integer; Offset: Longint);
begin
   if (Index < 0) or (Index >= FCount) then Error;
   BeginUpdate;
   try
      Markers[Index]^.Offset := Offset;
      Sort;
   finally
      EndUpdate;
   end;
end;

{-- TMMMarkerList --------------------------------------------------------}
procedure TMMMarkerList.SetColor(Index: integer; Color: Longint);
begin
   if (Index < 0) or (Index >= FCount) then Error;
   if (Color <> Markers[Index]^.Color) then
   begin
      Changing;
      Markers[Index]^.Color := Color;
      Changed;
   end;
end;

{-- TMMMarkerList --------------------------------------------------------}
procedure TMMMarkerList.Assign(Source: TPersistent);
var
   i: integer;
   p: TMMMarker;

begin
   if (Source is TMMMarkerList) or (Source = nil) then
   begin
      if (Source <> Self) then
      begin
         BeginUpdate;
         try
            Clear;
            if (Source <> nil) then
            begin
               for i := 0 to TMMMarkerList(Source).Count-1 do
               begin
                  p := TMMMarkerList(Source).Markers[i]^;
                  Add(p);
               end;
               Sort;
            end;

         finally
            EndUpdate;
         end;
      end;
   end
   else inherited assign(Source);
end;

{-- TMMMarkerList --------------------------------------------------------}
function TMMMarkerList.FindFreeID: Longint;
Label Again;
var
   i: integer;
begin
   Randomize;
Again:

   {$IFDEF WIN32}
   Result := Random(MaxLongint);
   {$ELSE}
   Result := Random(65535);
   {$ENDIF}
   for i := 0 to Count-1 do
   begin
      if (Result <= 0) or (Markers[i]^.ID = Result) then
         goto Again;
   end;
end;

{-- TMMMarkerList --------------------------------------------------------}
{ LocatePoint gibt den Index des ersten Markers, der rechts von Offset liegt,
  zurueck. Ist die Liste leer: -1 , gibt es kein rechtes Element mehr: Count(!) }
function TMMMarkerList.LocateMarker(Offset: Longint): integer;
var
   L, H : integer;

begin
   if (Count = 0) then
   begin
      Result := -1;
   end
   else
   begin
      if Markers[Count-1]^.Offset <= Offset then
      begin
         Result := Count;
      end
      else
      begin
         L := 0;
         H := Count-1;
         Result := H shr 1;
         while L < H do
         begin
            if (Markers[Result]^.Offset <= Offset) then
               L := Result+1
            else
               H := Result;
            Result := (L + H) shr 1;
         end;
      end;
   end;
end;

{-- TMMMarkerList --------------------------------------------------------}
{ QueryPoint returns true if a new marker is allowed at "Offset"          }
function TMMMarkerList.QueryMarker(Offset: Longint): Boolean;
begin
   Result := Findmarker(Offset) = -1;
end;

{-- TMMMarkerList --------------------------------------------------------}
{ FindMarker gibt genau den Index des Markers zurueck, oder -1 }
function TMMMarkerList.FindMarker(Offset: Longint): integer;
var
  i : integer;

begin
   Result := -1;
   i := LocateMarker(Offset);
   if (i > 0) and (i <= Count) then
   begin
      if Offset = Markers[i-1]^.Offset then
      begin
         Result := i-1;
      end;
   end
   else if (i = 0) and (Count > 0) then
   begin
      if Offset = Markers[i]^.Offset then
      begin
         Result := i;
      end;
   end;
end;

{-- TMMMarkerList --------------------------------------------------------}
{ FindConnectedMarker gibt den Index eines zugeh鰎igen  Markers zurueck }
function TMMMarkerList.FindConnectedMarker(index: integer): integer;
var
  i : integer;

begin
   Result := -1;
   if (Index < 0) or (Index >= FCount) then Error;
   
   if (Markers[Index]^.NextID > 0) then
   begin
      for i := 0 to Count-1 do
      begin
         if (Markers[i]^.ID = Markers[Index]^.NextID) then
         begin
            Result := i;
            exit;
         end;
      end;
   end;
end;

{-- TMMMarkerList --------------------------------------------------------}
procedure TMMMarkerList.Sort;
var
   i,j,h: integer;
   m: TMMMarker;

begin          { Start Shell-Sort }
   h := 1;
   while h <= Count div 9 do h := h*3 + 1;
   while h > 0 do
   begin
      for i := h to Count-1 do
      begin
         m := Markers[i]^;
         j := i;
         while (j >= h) and (Markers[j-h]^.Offset > m.Offset) do
         begin
            Markers[j]^ := Markers[j-h]^;
            dec(j, h);
         end;
         Markers[j]^ := m;
      end;
      h := h div 3;
   end;
end;

end.