Mine

{
  Copia nome da pasta ate o level definido
}
function CopyPathLevel(APath: String; ALevel: Integer): String;
var
  P, L: Integer;
  S1, S2 : String;
  EndP: Boolean;
begin
  if Length(Trim(APath)) > 0 then
  begin
    P := Pos('\', APath);

    if P > 0 then
    begin
      S2 := APath;
      EndP := False;

      for L := 1 to ALevel do
      begin
        if EndP then
        begin
          if S2 = '' then
            Result := '';

          Break;
        end;

        P := Pos('\', S2);

        if P > 0 then
        begin
          S1 := Copy(S2, 1, P);
          S2 := Copy(S2, P+1, Length(S2));
        end
        else
        begin
          S1 := S2;
          S2 := '';
        end;

        if S2 = '' then
          EndP := True;

        Result := Result + S1;
      end;

      if Length(Result) > 0 then
        if Result[Length(Result)] = '\' then
          Delete(Result, Length(Result), 1);
    end;

  end;
end;