FAQ VCL
Операции над строками

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как определить, является ли символ буквой расского алфавита?

function isAlphaRu(c: Char): Boolean;
begin
  Result := Ord(c) in [168, 184, 192..223, 224..255];
end;


Как определить, является ли символ буквой английского алфавита?

function isAlphaEn(c: Char): Boolean;
begin
  Result := Ord(c) in [65..90, 97..122];
end;


Как определить, является ли символ цифрой?

function isDigit(c: Char): Boolean;
begin
  Result := Ord(c) in [48..57];
end;


Как найти последнее вхождение подстроки в строке?

// Способ первый
function LastPos(SubStr: string; Str: string): Integer;
var
  ind, i: Integer;
begin
  i := 0;
  Result := Length(Str);
  ind := Length(SubStr);
  while Result > 0 do
  begin
    if str[Result] = substr[ind] then
      if ind = 1 then
        Break
      else
      begin
        Dec(ind);
        Inc(i);
      end
    else
    begin
      ind := Length(SubStr);
      Inc(Result, i);
      i := 0;
    end;
    Dec(Result);
  end;
end;

// Способ второй
function LastPos(SubStr: string; Str: string): Integer;
var
  i: Integer;
begin
  Result := 0;
  if (Length(SubStr) = 0) or (Length(Str) = 0) or
     (Length(SubStr) > Length(Str)) then
    Exit;

  for i := Length(Str) - Length(SubStr)+1 downto 1 do
    if Copy(Str, i, Length(SubStr)) = SubStr then
    begin
      Result := i;
      Break;
    end;
end;


Как разбить строку на части по определенному символу, словам или количеству символов?

// Способ первый
type
  TDelim = set of Char;
  TArrayOfString = array of string;

implementation

{$R *.dfm}

function fcToParts(str: String; Delim: TDelim): TArrayOfString;
var
  iCounter, iBegin: Integer;
begin
  if Length(str) > 0 then
  begin
    Include(Delim, #0);
    iBegin := 1;
    SetLength(Result, 0);
    for iCounter := 1 to Length(str)+1 do
    begin
      if str[iCounter] in Delim then
      begin
        SetLength(Result, Length(Result)+1);
        Result[Length(Result)-1] := Copy(str, iBegin, iCounter-iBegin);
        iBegin := iCounter + 1;
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  StrArr: TArrayOfString;
begin
  StrArr := fcToParts('строка1-строка2@строка3', ['-','@']);
  ShowMessage(StrArr[0] + #13 + StrArr[1] + #13 + StrArr[2]);
end;

// Способ второй
procedure Explode(var a: array of string; Border, S: string);
var
  S2: string;
  i: Integer;
begin
  i := 0;
  S2 := S + Border;
  repeat
    a[i] := Copy(S2, 0, Pos(Border, S2) - 1);
    Delete(S2, 1, Length( a[i] + Border));
    Inc(i);
  until S2 = '';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  S: string;
  A: array of string;
begin
  S := 'name|family|year'; // разбиваемая строка с текстом
  SetLength(A, 10);// указываем длину нашего массива
  Explode(A, '|', S);
  ShowMessage(A[0] + #13 + A[1] + #13 + A[2]);
end;

// Способ третий
{ function WrapText(const Line, BreakStr: string; BreakChars: TSysCharSet; MaxCol:  Integer): string; overload;
  function WrapText(const Line: string;  MaxCol:  Integer = 45): string;overload;

  Функция WrapText возвращает копию Line, разбитую на несколько строк шириной MaxCol столбцов. Каждая строка
  разбивается, когда ее длина доходит до MaxCol символов. Разбиение производится там, где есть символы из
  множества BreakChars. При нахождении символа из BreakChars, после него вставляется строка BreakStr. (В
  Delphi 5 как существующие переводы строк рассматриваются символы #13 и #10, независимо от BreakStr.)

  Вторая форма WrapText использует [' ', ' -' , #9] (пробел, дефис, табуляция) в качестве BreakChars и #13#10
  (возврат каретки, перевод строки) в качестве BreakStr. Получается эта форма просто переносит строку по словам.

  В качестве примера TListBox заполняется строками, примерно, как в TMemo и ширина и количество строк меняются,
  при изменении размера TListBox. Также в примере есть алгоритм подгонки ширины строк к ширине окна: }

procedure TForm1.FormResize(Sender: TObject);
var
  s: string;
  DC: HDC;
  Metrics: TTextMetric;
  CharsInWidth: Integer; //Сколько символов влезет в ширину окна
  OldMapMode: Integer;
begin
  s :=  'Очень длинная строка, которую мы сейчас разбиваем на ';
  s := s + 'кусочки и заполняем ими строки TListBox по всей ширине. ';
  s := s + 'Ширину TListBox мы меняем, изменяя размеры формы, ';
  s := s + 'т.к. у TListBox свойство Align равно alClient.';
  DC := GetWindowDC(ListBox1.Handle); // Получаем контекст окна
  SelectObject(DC, ListBox1.Font.Handle); // Выбираем в него шрифт окна
  OldMapMode := GetMapMode(DC); // Запоминаем старый режим отображения
  SetMapMode(DC, MM_TEXT); // Устанавливаем отображение в пикселях
  GetTextMetrics(DC, Metrics); // Получаем параметры шрифта
  SetMapMode(DC, OldMapMode); // Восстанавливаем режим отображения
  ReleaseDC(ListBox1.Handle, DC); // Освобождаем контекст
  // Получаем количество средних символов на ширину окна (8 - подобрано)
  CharsInWidth := ListBox1.ClientWidth div Metrics.tmAveCharWidth - 8;
  ListBox1.Clear; // Очищаем TListBox
  ListBox1.Items.Text := WrapText(s, CharsInWidth); //Заполняем TListBox
  Caption := 'Количество строк в ListBox = ' + IntToStr(ListBox1.Count);
end;

// Способ четвертый
procedure SplitText(S: string; Delimiter: Char; var Result: TStrings);
var
  i: Integer;
begin
  Result.Delimiter := Delimiter;
  Result.DelimitedText := S;
end;

procedure TForm2.Button1Click(Sender: TObject);
const
  Path = 'c:\temt\1.txt';
var
  Strings: TStrings;
begin
  Strings := TStringList.Create;
  SplitText(Path, '\', Strings);
  ShowMessage(Strings[0] + #13 + Strings[1] + #13 + Strings[2]);
  Strings.Free;
end;

// Способ пятый
procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
  arr: TArray;
begin
  sl := TStringList.Create;

  try
    sl.Text := 'a b c'.Replace(' ', #13);
    arr := sl.ToStringArray;
  finally
    sl.Free;
  end;
end;

// Способ шестой
procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
  arr: array of string; // TArray;
begin
  sl := TStringList.Create;

  try
    sl.Delimiter := ' ';
    sl.DelimitedText := 'a b c';
    TArray(arr) := sl.ToStringArray;
  finally
    sl.Free;
  end;
end;


Как обратить строку?

function ReverseStr(Source: string): string;
var
  i, x: Cardinal;
begin
  x := 0;
  for i := Length(Source) downto 1 do
  begin
    Inc(x);
    Result := Result + Source[i];
    SetLength(Result, x);
  end;
end;


Как получить индекс определенного (по счету) вхождения подстроки в строку?

function PosEx(SubStr, Str: string; Index: Word): Cardinal;
var
  i, idx: Integer;
begin
  Result := 0;
  i := 0;
  while (Pos(SubStr, Str) > 0) and (Length(Str) > 0) and (i < Index) do
  begin
    idx := Pos(SubStr, Str);
    Delete(Str, 1, idx);
    Inc(i);
    Result := Result + idx;
  end;
  if i < Index then
    Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Поиск 3-ей запятой в строке
  ShowMessage(IntToStr(PosEx(',', '1,2,3,2,5,6', 3)));
end;


Как получить индекс первого интересующего нас символа в строке, начиная с указанной позиции?

function PosAtIndex(const SubStr, Str: string; Index: Word): Cardinal;
begin
  Result := Pos(SubStr, Copy(Str, Index, Length(Str)));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(PosAtIndex('42', '13,42,83,42,5,6', 6)));
end;


Как проверить, является ли слово правильным Delphi-идентификатором?

procedure TForm1.Button1Click(Sender: TObject);
const
  Msg: array [Boolean] of string = ('False', 'True');
begin
  ShowMessage(Msg[IsValidIdent('Button1,')]);
end;

// В последних версиях Delphi у функции IsValidIdent появился необязательный параметр
// AllowDots, по умолчанию равный False. Если изменить его на True, то строки,
// содержащие в себе точку, будут считаться правильными идентификаторами.

procedure TForm1.Button1Click(Sender: TObject);
const
  Msg: array [Boolean] of string = ('False', 'True');
begin
  ShowMessage(Msg[IsValidIdent('Button1.2,', True)]);
end;


Как использовать case для работы со строками?

uses
  {...,} StrUtils;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // С помощью индексирования строк,
  // индексация осуществляется без учета регистра
  case AnsiIndexText(Edit1.Text, ['привет', 'Пока']) of
    0: ShowMessage('И тебе привет!');
    1: ShowMessage('Пока-пока!');
    else
      ShowMessage('ХЗ');
  end;
end;

При использовании материала - ссылка на сайт обязательна