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;


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

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;

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