Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Деление строки не несколько строк

01.01.2007
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Делит строку аStr на три строки St1,St2,St3 длиной Long1,Long2,Long3
 
Делит строку аStr на три строки St1,St2,St3 длиной Long1,Long2,Long3
соответственно или меньше в зависимости от длины исходной строки.
 
Зависимости: ???
Автор:       Сергей, nfkazak@inbox.ru, Краснодар
Copyright:   VIP BANK
Дата:        11 сентября 2002 г.
***************************************************** }
 
procedure
DivPart(aStr: string; var St1, St2, St3: string; Long1, Long2, Long3:
 
byte);
var
  i
, pos, Long: byte;
begin
  St1
:= '';
  St2
:= '';
  St3
:= '';
  aStr
:= Trim(aStr);
 
Long := Length(aStr);
 
if Long <= Long1 then
 
begin
    St1
:= aStr;
   
Exit
 
end;
 
Pos := Long1;
 
for i := 1 to Long1 + 1 do
   
if aStr[i] = ' ' then
     
Pos := i;
  St1
:= TrimRight(Copy(aStr, 1, Pos));
 
Delete(aStr, 1, Pos);
  aStr
:= TrimLeft(aStr);
 
Long := Length(aStr);
 
if Long <= Long2 then
 
begin
    St2
:= aStr;
   
Exit
 
end;
 
Pos := Long2;
 
for i := 1 to Long2 + 1 do
   
if aStr[i] = ' ' then
     
Pos := i;
  St2
:= TrimRight(Copy(aStr, 1, Pos));
  St3
:= Trim(Copy(aStr, Pos + 1, Long3))
end;

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Разбивка строки на подстроки с использованием заданного разделителя
 
Параметры: Str: WideString - Строка для разбивки
Delimiter: String - Разделитель подстрок с строке Str
Результат: TStringList: Список найденных подстрок
 
Зависимости: System, Sysutils, Classes
Автор:       Stoma, stoma@bitex.bg
Copyright:   Собственная разработка
Дата:        4 августа 2003 г.
***************************************************** }
 
function Tokenize(Str: WideString; Delimiter: string): TStringList;
var
  tmpStrList
: TStringList;
  tmpString
, tmpVal: WideString;
 
DelimPos: LongInt;
begin
  tmpStrList
:= TStringList.Create;
 
TmpString := Str;
 
DelimPos := 1;
 
while DelimPos > 0 do
 
begin
   
DelimPos := LastDelimiter(Delimiter, TmpString);
    tmpVal
:= Copy(TmpString, DelimPos + 1, Length(TmpString));
   
if tmpVal <> '' then
      tmpStrList
.Add(UpperCase(tmpVal));
   
Delete(TmpString, DelimPos, Length(TmpString));
 
end;
 
Tokenize := tmpStrList;
end;
Пример использования:
 
function TForm1.GetDirNames(FullPath: string): TStringList;
begin
 
GetDirNames := Tokenize(FullPath, '\');
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;
 
 
// How to use it:
// Und hier ein Beispiel zur Verwendung:
 
procedure TForm1
.Button1Click(Sender: TObject);
 
var
    S
: string;
   A
: array of String;
 
begin
   S
:= 'Ein Text durch Leerzeichen getrennt';
   
SetLength(A, 10);
   
Explode(A, ' ', S);
   
ShowMessage(A[0] + ' ' + A[1] + ' ' + A[2] + ' ' + A[3] + ' ' + A[4]);
 
end;
 

Взято с сайта: https://www.swissdelphicenter.ch