Обрезание имени файла по длине

Delphi , Синтаксис , Текст и Строки

Автор: ___Nikolay
WEB-сайт: http://delphiworld.narod.ru

// Обрезание имени файла по длине
function CutFoldersFromFileName(s: string; iLength: integer): string;
var
  bm: TBitmap;
  sResult: string;
  iStrLen: integer;

  // Поменять порядок символов в строке
  function ChangeLettersOrder(s: string): string;
  var
    sResult: string;
    i: integer;
  begin
    sResult := '';
    if Trim(s) <> '' then
      for i := Length(s) downto 1 do
        sResult := sResult + s[i];
    Result := sResult;
  end;

  // Количество вхождений символа в строку
  function SymbolEntersCount(ch: char; s: string; bCaseInsensitive: boolean): integer;
  var
    i, iResult: integer;
    cSymbol: char;

    function LoCase(ch: char): char;
    begin
      if (ch in ['A'..'Z', 'А'..'Я']) then
        result := chr(ord(ch) + 32)
      else
        result := ch;
    end;

  begin
    iResult := 0;
    if bCaseInsensitive then
      ch := LoCase(ch);
    if s <> '' then
      for i := 1 to Length(s) do
      begin
        cSymbol := s[i];
        if bCaseInsensitive then
          cSymbol := LoCase(cSymbol);
        if cSymbol = ch then
          inc(iResult);
      end;
    Result := iResult;
  end;

  // Удалить имя последнего каталога из полного имени файла
  function DeleteLastFolderFromFileName(sFileName: string): string;
  var
    sResult, sFName: string;
  begin
    sResult := sFileName;
    if Pos('\...\', sResult) <> 0 then
      Delete(sResult, Pos('\...\', sResult), 4);
    if SymbolEntersCount('\', sResult, false) < 2 then
    begin
      Result := sFileName;
      exit;
    end;
    sResult := ChangeLettersOrder(sResult);
    sFName := ChangeLettersOrder(Copy(sResult, 1, Pos('\', sResult) - 1)); // Взяли имя файла
    Delete(sResult, 1, Pos('\', sResult)); // Удалили имя файла
    Delete(sResult, 1, Pos('\', sResult)); // Удалили имя каталог перед именем файла
    sResult := ChangeLettersOrder(sResult) + '\...\' + sFName;
    Result := sResult;
  end;

begin
  Result := s;
  if (Trim(s) = '') or (SymbolEntersCount('\', s, false) < 2) then
    exit;

  sResult := s;
  bm := TBitmap.Create;
  bm.Width := 100;
  bm.Height := 100;
  iStrLen := bm.Canvas.TextWidth(sResult);
  while iStrLen > iLength do
  begin
    sResult := DeleteLastFolderFromFileName(sResult);
    iStrLen := bm.Canvas.TextWidth(sResult);
    if SymbolEntersCount('\', sResult, false) < 3 then
      break;
  end;
  bm.Free;
  Result := sResult;
end;

Перевод контента на русский язык:

Приведенный код - функция Delphi под именем CutFoldersFromFileName, которая обрезает имя файла до указанной длины, сохраняя структуру папок. Функция использует несколько вспомогательных функций:

1. ChangeLettersOrder: Переворачивает порядок символов в строке.
2. SymbolEntersCount: Считает количество вхождений конкретного символа (символа) в строке, опционально игнорируя регистр.
3. DeleteLastFolderFromFileName: Удаляет последнюю папку из имени файла.

Распределение кода:

1. Основная функция CutFoldersFromFileName принимает два параметра: s (имя файла для обрезки) и iLength (желаемая длина).
2. Она инициализирует пустую строку sResult, чтобы хранить обрезанное имя файла.
3. Если входное имя файла пусто или не имеет хотя бы двух уровней папок, функция возвращает оригинальное имя файла.
4. Функция создает объект TBitmap под именем bm и устанавливает его ширину и высоту в 100x100 пикселей.
5. Она рассчитывает начальную длину имени файла с помощью bm.Canvas.TextWidth.
6. Если начальная длина больше желаемой длины, функция вступает в цикл для обрезки имени файла:
   • Вызывает DeleteLastFolderFromFileName, чтобы удалить последнюю папку из имени файла.
   • Рассчитывает новую длину имени файла с помощью bm.Canvas.TextWidth.
   • Если новая длина все еще больше желаемой длины и есть хотя бы три уровня папок, функция продолжает обрезать имя файла.
7. Когда имя файла обрезается до желаемой длины или не может быть обрезано дальше (т.е., меньше трех уровней папок), функция освобождает объект TBitmap и возвращает обрезанное имя файла.

Вспомогательные функции работают следующим образом:

1. ChangeLettersOrder: Переворачивает порядок символов в строке, перебирая оригинальную строку с конца к началу и конкатенируя символы в новую строку.
2. SymbolEntersCount: Считает количество вхождений конкретного символа (символа) в строке, опционально игнорируя регистр. Она перебирает входную строку, преобразует каждый символ в нижний регистр, если это необходимо, и увеличивает счетчик для совпадающих символов.
3. DeleteLastFolderFromFileName: Удаляет последнюю папку из имени файла, выполняя следующие шаги:
   • Найдет последнее вхождение символа \ (сепаратора папок).
   • Удаляет последние четыре символа (...\) из имени файла.
   • Если нет ...\, удаляет последний уровень папки, найдя последний символ \ и удалив все после него.

Код кажется простым реализацией для обрезки имён файлов, сохраняя структуру папок. Однако он может не обрабатывать все краевые случаи или не поддерживать не-английские символы правильно. Важно тщательно тестировать функцию с различными вводами, чтобы обеспечить ее надежность.

Обрезание имени файла по длине - статья описывает функцию для обрезания длинного имени файла до заданной длины.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Текст и Строки ::