Текущий архив: 2004.01.16;
Скачать: CL | DM;

Вниз

Функция разбивающая строку по разделителям...   Найти похожие ветки 

← →
Knight ©   (2003-12-22 16:16) [0]

... и загоняющая результат в массив. Упростите, кто-нибудь это... желательно без TStrArr...

>> Sha © (22.12.03 15:18) [41]
> Сколько параметров у Explode?
Можно добавить символ разделителя (у меня он передаётся, как первый символ разбиваемой строки). Остальное не важно, лишь бы работало и без дополнительных типов.


type TStrArr=Array of String;

function Explode(Str:String):TStrArr;
var i,k,Len:Integer;
begin
Result:=nil;
Len:=Length(Str);
if Len>0 then begin
k:=1;
for i:=2 to Len+1 do begin
if (i=Len+1) or (Str[i]=Str[1]) then begin
SetLength(Result,Length(Result)+1);
Result[High(Result)]:=Copy(Str,k+1,i-k-1);
k:=i;
end;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var A:TStrArr;
i:Integer;
begin
Memo1.Clear;
A:=Explode(false," Имеется переменная String как ее разбить на символы?");
for i:=0 to Length(A)-1 do Memo1.Lines.Append(A[i]);
A:=nil;
end;


---

← →
Ega23 ©   (2003-12-22 16:18) [1]

Function DelimitedStrToList(sIn:string; Strs:Tstrings;delims:TCharSet):integer;
var i:integer;
s0,s1:string;
ch:char;
begin
if sIn="" then Exit;
strs.Clear;
s0:=sIn;
for i:=0 to 255 do //repl ;; =>; ;
begin
ch:=chr(i);
if ch in Delims then s0:=ReplaceStr(S0,ch+ch, ch+" "+ch);
end;
i:=1;
while true do
begin
s1:=ExtractWord(i,s0,delims);
if s1="" then break;
strs.add(s1);
inc(i);
end;
result:=strs.Count;
end;

Но это с использованием Rx-овского StrUtils

---

← →
Rouse_ ©   (2003-12-22 16:21) [2]

procedure TForm1.Button1Click(Sender: TObject);
var
S: String;
begin
S := "1#2#3#4";
Memo1.Text := StringReplace(S, "#", #13#10, [rfReplaceAll]);
end;

Так пойдет ;)

---

← →
Sha ©   (2003-12-22 16:26) [3]

// Sha_UnchainFirstWord отделяет первое слово от строки.
// Выделенное слово не содержит разделителей. Оставшаяся после отделения
// часть строки в месте раздела не содержит разделителей.
function Sha_UnchainFirstWord(Delimiter: char; var Tail: string): string;
var
i, len1, len2: integer;
p: pchar;
begin;
UniqueString(Tail);
p:=pointer(Tail);

i:=0; len1:=Length(Tail); len2:=0;
if i<len1 then repeat;
if p[i]<>Delimiter then inc(len2) else if len2>0 then break;
inc(i);
until i>=len1;

if len2>0 then begin;
SetString(Result,pchar(@p[i-len2]),len2);
while (i<len1) and (p[i]=Delimiter) do inc(i);
len1:=len1-i;
if len1=0 then Tail:="" else begin;
System.Move(p[i],p[0],len1+1);
(pinteger(p-4))^:=len1;
end;
end
else begin;
Tail:=""; Result:="";
end;
end;

// Sha_UnchainLastWord отделяет последнее слово от строки.
// Выделенное слово не содержит разделителей. Оставшаяся после отделения
// часть строки в месте раздела не содержит разделителей.
function Sha_UnchainLastWord(Delimiter: char; var Head: string): string;
var
i, len: integer;
p: pchar;
begin;
UniqueString(Head);
p:=pointer(Head);

i:=Length(Head)-1; len:=0;
if i>=0 then repeat;
if p[i]<>Delimiter then inc(len) else if len>0 then break;
dec(i);
until i<0;

if len>0 then begin;
SetString(Result,pchar(@p[i+1]),len);
while (i>=0) and (p[i]=Delimiter) do dec(i);
if i<0 then Head:=""
else begin;
p[i+1]:=#0;
(pinteger(p-4))^:=i+1;
end;
end
else begin;
Head:=""; Result:="";
end;
end;

---

← →
Knight ©   (2003-12-22 16:37) [4]

>> Ega23 © (22.12.03 16:18) [1]
У меня и то на оди проход, а тут сперва подготовка строки для другой функции, которая использует другую функцию... вобщем через ж..у как-то :)

>> Rouse_ © (22.12.03 16:21) [2]
:)
Вторая часть это демонстрация, что она работает... на самом деле массив используется иначе.

>> Sha © (22.12.03 16:26) [3]
Если я правильно понял, то это что-то другое... :)

---

← →
ИдиотЪ ©   (2003-12-22 16:40) [5]

так надо в один проход или нормально все-таки сделать ?
пихать все в одну процедуру - будущего не светит

---

← →
Ega23 ©   (2003-12-22 16:41) [6]

> Knight © (22.12.03 16:37) [4]

Тебе чего надо-то? Функция готовая или ты изысками теоретическими занимаешься для совершенствования алгоритма?

---

← →
Sha ©   (2003-12-22 16:43) [7]

> Knight © (22.12.03 16:37) [4]
> Если я правильно понял, то это что-то другое... :)

А дальше сам :)

---

← →
Sha ©   (2003-12-22 16:49) [8]

Вот тебе за один проход:
// Sha_WordsToRightMarkedText собирает текст из слов, вставляя между ними
// символ Mark. В конец собранной строки всегда добавляется Mark.
// Специальной обработки кавычек не производится.
// Символы Mark, встреченные в словах, заменяются символами NotMark.
// Если Compress=true, то выполняется сжатие пробелов и управляющих символов в словах.
function Sha_WordsToRightMarkedText(Words: TStrings;
Mark: char= #127; NotMark: char= #32; Compress: boolean= true): string;
var
MarkString: string;
start, stop: pchar;
i: integer;
wd: string;
ch: char;
before, after: boolean;
begin;
MarkString:=Mark;
Result:="";
before:=Compress and (Mark=#32);
after:=Compress and (not before);
with Words do for i:=0 to Count-1 do begin;
wd:=Strings[i];
if before then Sha_SpaceCompressInplace(wd);
start:=pointer(wd);
if start<>nil then begin;
stop:=start + Length(wd);
while true do begin;
ch:=start^;
inc(start);
if (ch>=#32) and (ch<>Mark) then continue;
if start>stop then break;
(start-1)^:=NotMark;
end;
end;
if after then Sha_SpaceCompressInplace(wd);
Result:=Result + wd + MarkString;
end;
end;

// Sha_RightMarkedTextToWords разбивает текст на слова.
// Разделителями слов считаются все управляющие символы (меньшие пробела)
// и Mark. Пробел не является разделителем слов, если только Mark<>#32.
// Специальной обработки кавычек не производится.
// Предварительная очистка списка слов не выполняется.
// Слова длиной меньше MinLength в список слов не включаются.
// Если Compress=true, то выполняется сжатие пробелов и управляющих символов в словах.
procedure Sha_RightMarkedTextToWords(const RightMarkedText: string; Words: TStrings;
Mark: char= #127; MinLength: integer= 0; Compress: boolean= true);
var
start, stop: pchar;
len: integer;
wd: string;
ch: char;
begin;
stop:=pointer(RightMarkedText);
if stop<>nil then repeat;
start:=stop;
repeat;
ch:=stop^;
inc(stop);
until (ch<#32) or (ch=Mark);
len:=stop-start-1;
if (ord(ch) or len<>0) and (len>=MinLength) then begin;
SetString(wd,start,len);
if Compress then Sha_SpaceCompressInplace(wd);
Words.Add(wd);
end;
until ch=#0;
end;

---

← →
Knight ©   (2003-12-22 16:49) [9]

Сам я в сабже... треба упростить или хотя бы совет, как избавиться от дополнительно типа...

---

← →
Knight ©   (2003-12-22 16:52) [10]

Странное у вас упрощение... в сабже функция на 17 строк (вместе с объявлением нового типа... :)

---

← →
ИдиотЪ ©   (2003-12-22 16:54) [11]

вот я помню в турбо-паскале на 286 хт, ну там еще имело смысл чего-то мудрить, но сейчас от ваших измышлений винда быстрее не заработает

---

← →
Sha ©   (2003-12-22 16:55) [12]

> Knight © (22.12.03 16:49) [9]

Советов больше, чем достаточно :)

Форум больше похож на стартер, чем на мотор.
Тебя толкнули, дальше крутись сам.
Если мотор постоянно глохнет, работа стартера бесполезна.

---

← →
ИдиотЪ ©   (2003-12-22 16:56) [13]

Sha ©
))
вай, харашо сказал, а

---

← →
Sha ©   (2003-12-22 16:58) [14]

> Knight © (22.12.03 16:52) [10]
> Странное у вас упрощение... в сабже функция на 17 строк

Так все-таки, сколько параметров у Explode?

---

← →
Rouse_ ©   (2003-12-22 17:12) [15]

> [12] Sha © (22.12.03 16:55)
Мощно задвинул... ;))

---

← →
Knight ©   (2003-12-22 17:21) [16]

>> Sha © (22.12.03 16:58) [14]
Символ разделителя, можно отдельно, можно как у меня.
Строка, которую надо разбить.

Вывод результата, можно как var процедуры, можно как Result функции.

Пробовал через указатели, но что-то не получается...

---

← →
Sha ©   (2003-12-22 17:26) [17]

> Knight © (22.12.03 17:21) [16]
а почему вызываешь так:
A:=Explode(false," Имеется переменная String как ее разбить на символы?");

---

← →
Ega23 ©   (2003-12-22 17:26) [18]

> Knight © (22.12.03 17:21) [16]

Ты чего хочешь? Минимальную по коду или полнофункциональную функцию?

---

← →
Sha ©   (2003-12-22 17:28) [19]

> Ega23 © (22.12.03 17:26) [18]

Тем более, что функция автора ветки, кажется, будет максимальной по времени.

---

← →
Knight ©   (2003-12-22 19:33) [20]

>> Sha © (22.12.03 17:26) [17]
> а почему вызываешь так:
> A:=Explode(false," Имеется переменная String как ее разбить на символы?");
Sorry... не с той кнопки скопировал... :)
A:=Explode(" Имеется переменная String как ее разбить на символы?");

> Тем более, что функция автора ветки, кажется, будет максимальной по времени.
Почему?

---

← →
Sha ©   (2003-12-22 19:44) [21]

> Knight © (22.12.03 19:33) [20]
>> Тем более, что функция автора ветки, кажется, будет максимальной по времени.
> Почему?

SetLength(Result,Length(Result)+1); вызывается для каждой буквы каждого слова. А это даже не две функции, как тебе показалось :)

Result[High(Result)]:=Copy(Str,k+1,i-k-1); вызывается для каждой буквы каждого слова. И здесь тоже не две функции, как тебе показалось :)

---

← →
Knight ©   (2003-12-22 19:52) [22]

> Sha © (22.12.03 19:44) [21]
А если по внимательнее посмотреть... может для каждого слова в предложении?

---

← →
Knight ©   (2003-12-22 19:54) [23]

В смысле набора символов между двумя разделителями...

---

← →
Sha ©   (2003-12-22 19:58) [24]

> Knight © (22.12.03 19:52) [22]

Да, точно. Недосмотрел.
Но все равно, если из Sha_RightMarkedTextToWords выбросить лишнее,
то она побыстрее будет.

---

← →
Knight ©   (2003-12-22 23:24) [25]

>> Sha © (22.12.03 19:58) [24]
Согласен.
С моей цикл на 1.000.000 работает 0:0:6:313.
С твоей (очищенной от лишнего) 0:0:5:422.

А вот следующий вариант выполняется за 0:0:3:547. Хотя если объеденить твой и мой будет ещё меньше, примерно, на секунду :)


function Explode(Str:String):TStrArr;
var i,k,n,LenStr,LenArr:Integer;
Ch:Char;
begin
Result:=nil;
LenStr:=Length(Str);
if LenStr>0 then begin
Ch:=Str[1];
LenArr:=0;
for i:=2 to LenStr do if (Str[i]=Ch) then Inc(LenArr);
SetLength(Result,LenArr+1);
k:=1;
n:=1;
for i:=0 to LenArr do begin
Inc(n);
while (n<=LenStr) and (Str[n]<>Ch) do Inc(n);
Result[i]:=Copy(Str,k+1,n-k-1);
k:=n;
end;
end;
end;


---

← →
Style ©   (2003-12-22 23:46) [26]

Только чета ваши функции на PHP explode не похожи совсем

function Explode($Separator, $Text) = Array

Причем $Separator - это тоже string;

---

← →
Knight ©   (2003-12-23 00:08) [27]

>> Style © (22.12.03 23:46) [26]
Ну мне полный аналог и не надо... главное, чтобы строку перегоняло в массив и ладно. :)

---

← →
Fantasist ©   (2003-12-23 01:41) [28]

procedure GetWords(WordList:TStrings; Text:string; Delimiters:set of char);
var
st,cur:pchar;
tmp:string;
len:Cardinal;
begin
cur:=pointer(text);
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
st:=cur;

while cur^<>#0 do
begin
inc(cur);
if cur^ in Delimiters then
begin
len:=Cardinal(cur)-Cardinal(st);
SetLength(tmp,len);
move(st^,pointer(tmp)^,len);
WordList.Add(tmp);

while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
st:=cur;
end;
end;
end;

---

← →
Style ©   (2003-12-23 02:03) [29]

Вот написал!

type
TStringArray = Array of string;

function Explode(Separator, Text: string): TStringArray;
var
acount,i, spos: integer;
textaddr,textsize,sepsize: integer;

function getstrlen(address: integer ): integer;
asm
lea eax, pointer(address)
sub eax, $04
mov eax, [eax]
mov result, eax
end;

function getaddr(pstring: pointer ): integer;
asm
lea eax, pointer(pstring)
mov eax, [eax]
mov result, eax
end;

function copyfromaddr(address, pos, count: integer): string;
var
memsize: integer;
mem: pchar;
begin
memsize := count+1;
getmem(mem,memsize);
zeromemory(mem,memsize);
copymemory(mem,pchar(address+pos-1),count);
result := mem;
freemem(mem);
end;

function scanfrompos(pos: integer): boolean;
var j: integer;
begin
result := false;

for j := 1 to sepsize do
begin
if(Text[pos+j] <> separator[j]) then exit;
end;

result := true;
end;

begin
textaddr := GetAddr(@Text);
if(textaddr = 0) then exit;
textsize := GetStrLen(textaddr);
sepsize := GetStrLen(GetAddr(@Separator));

i := $1;
acount := i;
spos := i;

while i < textsize+1 do
begin

if(scanfrompos(i-1)) then
begin
if(spos <> i) then
begin
SetLength(result,acount);
result[acount-1] := copyfromaddr(textaddr,spos,i-spos);

Inc(Acount);
i := i + sepsize;
spos := i;
end;

end
else
Inc(i);
end;

if(spos <= textsize) then
begin
SetLength(result,acount);
result[acount-1] := copyfromaddr(textaddr,spos,textsize-spos+1);
end;

end;

---

← →
Fantasist ©   (2003-12-23 02:07) [30]

> Knight © (22.12.03 23:24) [25]


Ты не учитываешь, что символы разделители могут идти подряд. Если нужно именно массив, то можно сделать так:


function GetWords(Text:string; Delimiters:set of char):TStrArr;
var
st,cur:pchar;
tmp:string;
len,count:Cardinal;
begin
count:=0;
SetLength(Result,0);

//пропустим разделители
cur:=pointer(text);
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
if cur^=#0 then exit;
st:=cur;

//сосчитаем слова
while (cur^<>#0) do
begin
inc(cur);
if (cur^ in Delimiters) do
begin
inc(count);
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
end;
end;
SetLength(Result,count+1);
count:=0;

cur:=st;
while cur^<>#0 do
begin
inc(cur);
if cur^ in Delimiters then
begin
len:=Cardinal(cur)-Cardinal(st);
SetLength(Result[count],len);
move(st^,pointer(Result[count])^,len);
inc(count);

while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
st:=cur;
end;
end;

//последнее слово
len:=Cardinal(cur)-Cardinal(st);
SetLength(Result[count],len);
move(st^,pointer(Result[count])^,len);
end;


---

← →
Style ©   (2003-12-23 02:11) [31]

Блин скока алгоритмов народ ужо насочинял :)
Дальше чувствую чистый машинный код пойдет или реализацию Explode с помощью MMX технологий хто нить забубенит!

8-)

---

← →
Fantasist ©   (2003-12-23 02:14) [32]

Единственно что перед параметром Text надо const написать.

---

← →
Fantasist ©   (2003-12-23 02:20) [33]

> Дальше чувствую чистый машинный код пойдет или реализацию
> Explode с помощью MMX технологий хто нить забубенит!


Это лишнее. Все прекрасно и оптимально реализуется средствами Дельфийского Паскаля. У тебя в коде идея правильная, только не до конца отточеная.

---

← →
Style ©   (2003-12-23 02:30) [34]

Вот отточил 8)

Кстати можно ускорить

1) сравнивать по слову (32 бита) c разделителем
2) массив создавать в конце вызывая setlength - 1 раз.

function Explode(Separator, Text: string): TStringArray;
var
acount,i, spos: integer;
textaddr,textsize,sepsize: integer;

function getstrlen(address: integer ): integer;
asm
lea eax, pointer(address)
sub eax, $04
mov eax, [eax]
mov result, eax
end;

function getaddr(pstring: pointer ): integer;
asm
lea eax, pointer(pstring)
mov eax, [eax]
mov result, eax
end;

function copyfromaddr(address, pos, count: integer): string;
var
memsize: integer;
mem: pchar;
begin
memsize := count+1;
getmem(mem,memsize);
zeromemory(mem,memsize);
copymemory(mem,pchar(address+pos-1),count);
result := mem;
freemem(mem);
end;

function scanfrompos(pos: integer): boolean;
var j: integer;
begin
result := false;

for j := 1 to sepsize do
begin
if(Text[pos+j] <> separator[j]) then exit;
end;

result := true;
end;

begin

textaddr := GetAddr(@Separator);
if(textaddr = 0) then
begin
SetLength(result,1);
result[0] := text;
exit;
end;
sepsize := GetStrLen(textaddr);

textaddr := GetAddr(@Text);
if(textaddr = 0) then exit;
textsize := GetStrLen(textaddr);

i := $1;
acount := i;
spos := i;

while i < textsize+1 do
begin

if(scanfrompos(i-1)) then
begin
if(spos <> i) then
begin
SetLength(result,acount);
result[acount-1] := copyfromaddr(textaddr,spos,i-spos);

Inc(Acount);
i := i + sepsize;
spos := i;
end else
begin
Inc(Acount);
i := i + sepsize;
spos := i;
end;

end
else
Inc(i)
end;

if(spos <= textsize) then
begin
SetLength(result,acount);
result[acount-1] := copyfromaddr(textaddr,spos,textsize-spos+1);
end;

end;

---

← →
Knight ©   (2003-12-23 09:21) [35]

>>Fantasist © (23.12.03 02:07) [30]
У меня всё верно. Если разделители повторяются, то считается, что между ними пустая строка ""

>> Style
Ещё не дочитал и не попробовал... коментарий позже... :)

---

← →
Style ©   (2003-12-23 09:35) [36]

2 Knight :)

Хочу коментариЙ!!!!! Ж8)

---

← →
Style ©   (2003-12-23 11:28) [37]

Не, ну как функция???

Первый раз чегото с использованием asm попробывал наваять :)

---

← →
Knight ©   (2003-12-23 12:03) [38]

>> Style © (23.12.03 11:28) [37]
Более 10 секунд... :)

---

← →
Sha ©   (2003-12-23 12:55) [39]

> Style © (23.12.03 11:28) [37]
> Первый раз чегото с использованием asm попробывал наваять :)

mov result, eax
Это лишнее.

Да и вообще, если писать на Pascal без вызова asm-функций, было бы быстрее :)

---

← →
Knight ©   (2003-12-23 12:59) [40]

Пока самое быстрое у Fantasist © (23.12.03 02:07) [30]
На 3 сотни миллисекунд быстрее моего.
Хотя лишнего тоже много... :)

---

← →
Sha ©   (2003-12-23 13:00) [41]

> Style © (23.12.03 11:28) [37]

lea eax, pointer(pstring)
Это тоже лишнее.

---

← →
Style ©   (2003-12-23 13:05) [42]

2 - sha
2 - Knight ©

Да я не на скорость смотрел, а на то чтобы Separator - был string
короче как в PHP Explode

т.е. моя функция и ваши - совершенно разные вещи!

А вообще лучше возвращать не массив string"ов , а массив

TStringRec = record
Adddes: longint
Count: longint
end;

Чтобы лишний раз не копировать память.
Тогда будет быстро!

---

← →
Sha ©   (2003-12-23 13:08) [43]

> Knight © (23.12.03 12:59) [40]

Скорее всего, это значит, что ты выбросил не все лишнее из моей функции :)
И уж если занялся сравнением скоростей, то замени во всех сравниваемых функциях TStringArray на TStringList, или наоборот.

---

← →
Sha ©   (2003-12-23 13:10) [44]

> Style © (23.12.03 13:05) [42]
> Да я не на скорость смотрел

Я тоже. Я лишь комментировал asm-код.

---

← →
Knight ©   (2003-12-23 14:10) [45]

>> Sha © (23.12.03 13:08) [43]
Выкинуд всё, что можно...
>> Style © (23.12.03 13:05) [42]
Могу сказать, что работает нормально :)
Вечером попробую ускорить...

---

← →
Sha ©   (2003-12-23 14:27) [46]

> Knight © (23.12.03 14:10) [45]
> Выкинуд всё, что можно...

Покажи, что осталось.

---

← →
Knight ©   (2003-12-23 14:29) [47]

>> Sha © (23.12.03 14:27) [46]
Снова править в лом... Буду дома часов в 9, закину.

---

← →
Style ©   (2003-12-23 15:01) [48]

2 Sha ©
-> А там эти asm функции на скорость и не влияют.
Они вызываются один раз. В цикле нет орбащения.

в принципе
getstrlength
это тоже самое что

integer(pinteger(integer(@text)-4)^)

---

← →
Sha ©   (2003-12-23 15:10) [49]

> Style © (23.12.03 15:01) [48]

> А там эти asm функции на скорость и не влияют.
Да не про скорость я, а про стиль. Эти операторы равны nop.

> в принципе getstrlength это тоже самое что integer(pinteger(integer(@text)-4)^)
И все это не равно length(@text)

---

← →
Sha ©   (2003-12-23 15:11) [50]

И все это не равно length(text)

---

← →
Style ©   (2003-12-23 15:32) [51]

Sha ©
должно быть равно.. или я сейчас не правильно записал

короче это указатель на укзатель в адресе @text - 4 типа longint

короче вот!

integer(pinteger(integer(pinteger(@s)^)-4)^)

---

← →
Sha ©   (2003-12-23 15:51) [52]

Style © (23.12.03 15:32) [51]

Если строка пустая, твой код даст ошибку.

---

← →
Style ©   (2003-12-23 16:36) [53]

Можно проверить на то что строка пустая....

А суть оптимизации в следующем - узнать адресс
где храниться text и засунуть в переменную
затем просто к этому адресу пребавлять pos в место того чтобы каждый раз при обращении к text узнавать его адресс

---

← →
Fantasist ©   (2003-12-23 20:55) [54]

> Хотя лишнего тоже много...


А конкрентнее?

---

← →
Fantasist ©   (2003-12-23 21:21) [55]

Возможен такой вариант. Он наверняка будет быстрее, если количество слов меньше BufferSize. В других вариантах не могу сказать, насколько быстро будет происходить перераспределение памяти по сравнению с изначальным подсчетом слов. По идее при достадочно большом BufferSize должно быть выгоднее.


function GetWords(const Text:string; Delimiters:set of char):TStrArr;
const
BufferSize=400;

var
st,cur:pchar;
tmp:string;
len,count:Cardinal;
begin
count:=0;
SetLength(Result,BufferSize);
cur:=pointer(text);

//пропустим разделители
while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
if cur^=#0 then exit;
st:=cur;

while cur^<>#0 do
begin
inc(cur);
if cur^ in Delimiters then
begin
if count=length(Result) then
SetLength(Result,length(Result)+BufferSize);

len:=Cardinal(cur)-Cardinal(st);
SetLength(Result[count],len);
move(st^,pointer(Result[count])^,len);
inc(count);

while (cur^<>#0) and (cur^ in Delimiters) do inc(cur);
st:=cur;
end;
end;

//последнее слово
if (st^<>#0) then
begin
len:=Cardinal(cur)-Cardinal(st);
SetLength(Result[count],len);
move(st^,pointer(Result[count])^,len);
end;
SetLength(Result,count);
end;


---

← →
Knight ©   (2003-12-23 22:43) [56]

>> Sha
Остальная урезка, будет изменением кода...
<copy>
procedure Sha_RightMarkedTextToWords(const RightMarkedText: PChar; Words: TStrings; Mark: char);
var
start, stop: PChar;
len: integer;
wd: string;
ch: char;
begin;
words.Clear;
stop:=pointer(RightMarkedText);
if stop<>nil then repeat
start:=stop;
repeat
ch:=stop^;
inc(stop);
until (ch=Mark) or (ch=#0);
len:=stop-start-1;
SetString(wd,start,len);
Words.Add(wd);
until ch=#0;
end;
</copy>

---

← →
Sha ©   (2003-12-23 23:04) [57]

Knight © (23.12.03 22:43) [56]
Не забыл заменить TStringList на TStringArray?

---

← →
Игорь Шевченко ©   (2003-12-23 23:17) [58]

В UBPFD (ссылка в форуме "Основная", вверху) лежит функция StrBreakApart (в разделе "Работа со строками). Насколько я понял из комментариев, она похожа на Explode.

---

← →
Knight ©   (2003-12-23 23:22) [59]

>> Sha © (23.12.03 23:04) [57]
Где? В твоём варианте? Это уже полная переделка... однако :)

---

← →
Sha ©   (2003-12-23 23:50) [60]

> Knight © (23.12.03 23:22) [59]

А тогда не говори, что моя функция медленнее.
Сравнил... понимаешь...

---

← →
Style ©   (2003-12-23 23:51) [61]

Ээээ народ вы мою обещали оптимизировать :)

Хочу 2 секунды!! :)

---

← →
Sha ©   (2003-12-23 23:57) [62]

> Игорь Шевченко © (23.12.03 23:17) [58]

Рад видеть.
А моя-то Sha_RightMarkedTextToWords побыстрее будет :)

---

← →
Игорь Шевченко ©   (2003-12-23 23:59) [63]

Sha © (23.12.03 23:57)


> Рад видеть.

Взаимно :)


> А моя-то Sha_RightMarkedTextToWords побыстрее будет

Охотно верю, я за скоростью не гнался, я честно взял за основу InfoPower"овскую :)) А они оптимизацией не отличались...

---

Страницы: 1 2 вся ветка

Текущий архив: 2004.01.16;
Скачать: CL | DM;

Наверх

Память: 0.65 MB
Время: 0.03 c