TList Filterfunktion

[p80286]

Ich hab da was aus TP Zeiten ausgegraben, es muß also auf jeden Fall überarbeitet werden:

Delphi-Quellcode:

type
  sortpoint =^sorts;
  sorts     = record next    :sortpoint;    {-  4 -}
                     last    :sortpoint;    {-  4 -}
                     satz    :string;       { +1  -}
              end;

var
  markpoint:^integer;
  lsterst :sortpoint;
  lstlezt :sortpoint;
  actsatz :sortpoint;
  sc      :longint;
  c       :integer;         { z„hler sc-    lc-L„ufe c-geschriebeneS.}
  hilfp   :string[5];
  cc      :integer;

procedure HEAPSORT; (*..............................................*)
var
    helpp  :sortpoint;
    medium :sortpoint;   { mittleres Element }
    klein  :sortpoint;   { Kleineres Element }
    gross  :sortpoint;   { GrӇeres Element  }
    n,m,i  :integer;


begin
  { -----------------------------------------INITIALISIEREN -----------}
  n:=0;
  m:=0;
  medium :=lsterst;                  {-- erstes E = MittelElem --}
  klein  :=medium;
  gross  :=medium;
  lstlezt:=lsterst^.next;
  medium^.last:=nil;
  medium^.next:=nil;
  { ----------------------------------------- SORTIEREN ---------------}
  repeat
    actsatz:=lstlezt;
    lstlezt:=lstlezt^.next;
    if actsatz^.satz<medium^.satz then begin  {------------------}
      inc(n,1);         {----------------- actsatz kleiner mittlerer satz --}
      if actsatz^.satz<klein^.satz then begin  {-- act<klein -----}
        if klein^.last=nil then begin
          klein^.last:=actsatz;
          actsatz^.next:=klein;
          klein:=actsatz;
          klein^.last:=nil;
        end
        else begin
          repeat
            helpp:=klein;
            klein:=klein^.last;
          until (klein^.satz<=actsatz^.satz) or (klein=nil);
          helpp^.last:=actsatz;
          actsatz^.last:=klein;
          actsatz^.next:=helpp;
          klein^.next:=actsatz;
          klein:=actsatz;
        end;
      end     { -------------------- actsatz< klein -------------------}
      else begin        {----------- actsatz>= klein-------------------}
        helpp:=klein;
        repeat
          helpp:=helpp^.next;
        until helpp^.satz>actsatz^.satz;
        klein:=helpp^.last;
        helpp^.last:=actsatz;
        klein^.next:=actsatz;
        actsatz^.next:=helpp;
        actsatz^.last:=klein;
      end;
    end   {------------ act<medium ----------------------------------- }
    else begin  {-------------------  actsatz>= medium --------------- }
      inc(m,1);
      if gross^.satz<=actsatz^.satz then begin  { gross<=act. ---}
        if gross^.next=nil then begin
          gross^.next:=actsatz;
          actsatz^.last:=gross;
          gross:=actsatz;
          gross^.next:=nil;
        end
        else begin
          repeat
            helpp:=gross;
            gross:=gross^.next;
          until (gross^.satz>actsatz^.satz) or (gross=nil);
          helpp^.next:=actsatz;
          actsatz^.last:=helpp;
          actsatz^.next:=gross;
          gross^.last:=actsatz;
          gross:=actsatz;
        end
      end
      else begin     {------------------ gross>actsatz -----------------}
        repeat
          gross:=gross^.last;
        until gross^.satz<=actsatz^.satz;
        helpp:=gross;
        gross:=gross^.next;
        helpp^.next:=actsatz;
        actsatz^.last:=helpp;
        actsatz^.next:=gross;
        gross^.last:=actsatz;
        gross:=actsatz;
      end; {---- gross>actsatz -----------------------------------------}
    end; {-------------- actsatz>=medium ----------------------------- }
    { ------------ ende Einf�gen ------------------------------------- }
    (*
    gotoxy(5,19);
    writeln(n:5,m:6);
    *)
    if abs(n-m)>200 then begin
      if m>n then begin
        for c:=1 to 50 do medium:=medium^.next;
        n:=n+50;
        m:=m-50;
      end
      else begin
        for c:=1 to 50 do medium:=medium^.last;
        m:=m+50;
        n:=n-50;
      end;
      if klein^.last<>nil then
        repeat
          klein:=klein^.last
        until klein^.last=nil;
      if gross^.next<>nil then
        repeat
          gross:=gross^.next
        until gross^.next=nil;
    end;
  until lstlezt=nil;
  { -------------------- ENDE SORTIEREN ------------------------------ }
  if klein=nil then klein:=medium;
  if klein^.last <>nil then repeat
    klein:=klein^.last;
  until klein^.last=nil;
  lsterst:=klein;
  writeln('verarbeitete S„tze: ',n+m+1);
end; {------------ HEAPSORT ------------------------------------------- }

Gruß
K-H