gleiche Zahlenfolgen im Array untersuchen

[Bjoerk]

Wenn du alle Results haben möchtest, dann kann man z.B. die bereits gefundenen aus der Liste rauslöschen.

Delphi-Quellcode:

function FindSubList(const SubList, List: TStringList; var Index: integer): integer;
var
  I, J, A, B: integer;
begin
  Result:= 0;
  A:= List.Count;
  B:= SubList.Count;
  I:= Index;
  if I < 0 then Exit;
  if B = 0 then Exit;
  if B > A then Exit;
  while (Result = 0) and (I <= A-B) do
  begin
    J:= 0;
    if (List[I] = SubList[J]) then
    begin
      while (J < B-1) and (List[I+J+1] = SubList[J+1]) do Inc(J);
      if J = B-1 then
      begin
        Result:= B;
        Index:= I;
      end;
    end;
    Inc(I);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SubList, List: TStringList;
  I, J, K, N, N1, J1, Index: integer;
  Result: string;
  done: boolean;
begin
  List:= TStringList.Create;
  SubList:= TStringList.Create;
  try
    List.Add('1');
    List.Add('2');
    List.Add('3');
    List.Add('4');
    List.Add('9');
    List.Add('8');
    List.Add('7');
    List.Add('1');
    List.Add('2');
    List.Add('3');
    List.Add('4');
    List.Add('6');
    List.Add('2');
    List.Add('3');
    List.Add('4');
    List.Add('9');
    List.Add('8');
    List.Add('7');
    repeat
      N:= 1;
      Result:= '';
      for I:= 0 to List.Count-2 do
        for J:= I+1 to List.Count-1 do
        begin
          SubList.Clear;
          for K:= I to J do SubList.Add(List[K]);
          J1:= J;
          N1:= FindSubList(SubList, List, J1);
          if N1 > N then
          begin
            N:= N1;
            Index:= J1;
            Result:= SubList.Text;
          end;
        end;
      done:= true;
      if N > 1 then
      begin
        ShowMessage('Tiefe= '+IntToStr(N)+#13+Result);
        done:= false;
        for I:= Index to N+Index-1 do List.Delete(Index);
      end;
    until done;
  finally
    List.Free;
    SubList.Free;
  end;
end;