Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Заменя пробелов [D6, Win2k]

Страницы: < 1 2 3 4 5 6 >
Adam © (2003-01-27 18:13:00)
Сдраствуйте мастера!

У меня следующяя проблема:

Имеется строка, в которой слова разделяются проделами. Количество пробелов между двумя словами неизвестно, оно может быть разным. Требуется это количество пробелов заменить всего одним пробелом.. Как это сделать? Помогите, пожалуйста..

Один из вариантов (2003-01-29 06:54:00) [81]
sorry после того как отправил заметил что уже такой вариант был

Один из вариантов (2003-01-29 06:52:00) [82]
А как насчет вот такого варианта?
function delspace(s:string):string;
var s:string
begin
while pos(" ",s) > 0 do // Delete " "
delete(s,pos(" ",s),1);
result:=s;
end;

Юрий Зотов (2003-01-29 01:29:00) [83]
Ну уж, чтобы и все приславшие код поучаствовали в конкурсе (кроме kkostik, поскольку его функция несколько из другой оперы).

> Separator © (28.01.03 10:56)
Вы правильно сказали - почти то же, что и у MAN-In-RED. Тоже не дает правильного результата (не верите - вызовите в цикле и увидите, что компилятор не всегда делает предварительную чистку строковых переменных). После поправки кода итог такой - 227, 232, 228. Практически то же, что и в первом варианте MAN-In-RED.

> Мефодий (28.01.03 15:57)
Результат - 280, 281, 283. Практически то же, что и во втором варианте MAN-In-RED, но закодировано, как Вы и говорили, в две простые строчки.

> Sha © (28.01.03 16:24)
Результат - 16, 20, 16. Если я правильно понял суть кода, идея Romkin"а дополнена самостоятельной работой с адресами, не полагаясь на компилятор. Итог - налицо.

Юрий Зотов (2003-01-29 01:00:00) [84]
> MAN-In-RED © (28.01.03 19:45)

> Что не так?

Пустячок - первый Ваш вариант просто не компилируется. А после устранения ошибки может сработать верно, а может и нет. Смотря какой первый символ в строке и на какой случайный мусор попадет переменная Spc (кстати, эта же болячка и во втором варианте - у Вас warning"и отключены, или Вы их просто в голову не берете?).

Ну, ладно, я внял Вашему призыву, что брать тоже надо уметь, и код чуть-чуть подчистил (надеюсь, Вы поверите, что я тоже немного умею кодить и не старался специально его ухудшить?)

Вот результат:
- первый Ваш вариант: 225, 226, 229
- второй Ваш вариант: 278, 273, 281

Так что Ваша апелляция возымела успех. Поздравляю с почетным третьим местом.

MAN-In-RED (2003-01-28 19:45:00) [85]

> Юрий Зотов © (28.01.03 10:04)

Я в шоке! Что значит не дает правильного результата, все дает, только брать надо уметь…:)
Я проверял, все прекрасно работает!

Вот моя функция:

function OneSpace(Str: String): String; var S :String; I :Integer; Spc :Boolean; begin for I:=1 to Length(Str) do if Str[i]=#32 then begin if not Spc then begin S := S+" "; Spc := True; end; end else begin S := S+Str[i]; Spc := False; end; Result := S; end;
Пример вызова:

ShowMessage(OneSpace("q wer t y u"));

Результат – q wer t y u

Все пробелы были заменены на один!
Что не так?

> Antosya © (27.01.03 21:39)

> Бук (28.01.03 13:25)

> Мефодий (28.01.03 15:57)

Код типа:
ShowMessage(StringReplace("q w e rty u i o ",#32#32,#32,[rfReplaceAll]));

Не даст нужного результата, разве что в цыкле...

Требую перепросмотра моей функции :)

Sha (2003-01-28 16:24:00) [86]
Тоже хочется поучаствовать:
function Sha(const s: string): string; const DeleteFirstBlank= false; DeleteLastBlank= false; var p: PChar; i, j, len: integer; ch: char; begin; len:=Length(s); SetLength(Result,len); if len>0 then begin; ch:=#0; if DeleteFirstBlank then ch:=" "; p:=pointer(s); j:=pointer(Result)-p; for i:=0 to len-1 do begin; if ch<>(p+i)^ then ch:=(p+i)^ else if ch=" " then continue; (p+j)^:=ch; inc(j); end; SetLength(Result,j-(pointer(Result)-p)-ord((ch=" ") and DeleteLastBlank)); end; end;

Мефодий (2003-01-28 15:57:00) [87]
А что если попроще:

function MySpaceEraser(s: string): string;
begin
while Pos(" ",s) > 0 do {в ковычках два пробела}
System.Delete(s,Pos(" ",s),1);
Result := s;
end;

Юрий Зотов (2003-01-28 15:18:00) [88]
> Бук (28.01.03 13:25)
> Сие действо можно повторить в цикле нужное количество раз.
> Быстро и сердито.

Результаты теста видели? Самый медленный из рассмотренных алгоритмов. Примерно в 70 раз уступает самому быстрому.

Это насчет "быстро". Что же касается "сердито"... а что это такое - "сердитый алгоритм"?

Который пишется в 2 строки? А всегда ли это хороший критерий?

Бук (2003-01-28 13:25:00) [89]
Ну вы блин даете!
memo1.Text:=AnsiReplaceText(memo1.Text,#32#32,#32);
Сие действо можно повторить в цикле нужное количество раз. Быстро и сердито.

REA (2003-01-28 11:27:00) [90]
Ну нифига себе проблема! Вы еще GREP подключите.

Separator (2003-01-28 10:56:00) [91]
Почти тоже, что и у MAN-In-RED © (27.01.03 21:44)
function StrDelSpace(S: string): string; var i: integer; Space: boolean; begin Space:= false; for i:= 1 to Length(S) do if (S[i] = #32) and (not Space) then begin Space:= true; Result:= Result + #32 end else if (S[i] <> #32) then begin Space:= false; Result:= Result + S[i] end end;

kkostik (2003-01-28 10:06:00) [92]
function StrDelSimv(PrStr : String; Simv : String) : String;
var i : Integer;
begin
i:=1;
While Length(PrStr)>=i Do
if PrStr[i]=Simv then
Delete(PrStr, i, 1)
else i:=i+1;
Result:=PrStr;
end;
Удаление любово символа из строки

Юрий Зотов (2003-01-28 10:04:00) [93]
function Song(S: string): string;
begin
Result := S;
while Pos(" ", Result) > 0 do // Без цикла не проходит.
Result := StringReplace(Result, " ", " ", [rfReplaceAll])
end;

function Antosya(S: string): string;
var
d: string[100];
b: integer;
begin
Result := S;
d := " ";
b := pos(d, Result);
if b <> 0 then
repeat
b := pos(d, Result);
if b <> 0 then delete(Result, b, 1);
until b = 0
end;

// function ManInRed(const s: string): string;
// Sorry, не дает правильного результата

function Romkin(const s: string): string;
var
NewLength, i, k: integer;
LastChar: char;
begin
Result := "";
NewLength := Length(s);
SetLength(Result, NewLength);
lastchar := #0;
k := 0;
for i := 1 to Length(s) do
if not ((LastChar = #32) and (s[i] = #32)) then
begin
Inc(k);
Result[k] := S[i];
LastChar := S[i]
end;
SetLength(Result, k)
end;

function Separator(S: string): string;
var
P: integer;
begin
Result := S;
P := Pos(" ", Result);
while P > 0 do
begin
Delete(Result, P, 1);
P := Pos(" ", Result)
end
end;

procedure TForm1.Button1Click(Sender: TObject);
const
Src = "Q W ER T Y U ";
var
Tick: DWORD;
i: integer;
S: string;
begin
Tick := GetTickCount;
for i := 1 to 10000 do
// S := Song(Src); // 1523, 1521, 1523
// S := Antosya(Src); // 423, 426, 424
// S := Romkin(Src); // 22, 25, 24
S := Separator(Src); // 215, 213, 214
Tick := GetTickCount - Tick;
Caption := Format("%s : %u", [S, Tick])
end;

Separator (2003-01-28 08:30:00) [94]
var i: integer; begin i:= Pos(#32#32, Edit1.Text); while i <> 0 do begin Delete(Edit1.Text, i, 1) i:= Pos(#32#32, Edit1.Text); end end
Правда работать будет долго

Romkin (2003-01-27 22:36:00) [95]
Кину и я камень...
function OneSpace(const s: string): string; var newLength, i, k: integer; lastChar: char begin Result := ""; newLength := length(s); if newLength = 0 then exit; SetLength(Result, newLength); lastchar := #0; k := 0; for i := 1 to length(s) do if not ((LastChar = #32) and (s[i] = #32)) then begin inc(k); Result[k] := s[i]; LastChar := s[i]; end; SetLength(Result, k); end;
Без отладки, но, думаю, идея должна быть ясна %-)) - переписываем только одинарные пробелы. Здесь еще страховка насчет нулевой длины и только одного символа в строке... Что в голову пришло, но работать должно быстро

MAN-In-RED (2003-01-27 21:50:00) [96]
Мой быстрее :)

MAN-In-RED (2003-01-27 21:44:00) [97]
Вот мой вариант:
procedure TForm1.Button1Click(Sender: TObject); var Str, S :String; I :Integer; Spc :Boolean; begin Str := "Q W ER T Y U "; for I:=1 to Length(Str) do if Str[i]=#32 then begin if not Spct then begin S := S+" "; Spc := True; end; end else begin S := S+Str[i]; Spc := False; end; ShowMessage(""""+S+""""); end;

Antosya (2003-01-27 21:39:00) [98]
Вот полностью работоющий код, !
var a,d:string[100]; b,c:integer; begin a:=Edit1.Text; //предположим, это твоя строка d:=" "; b:=pos(d,a); if b<>0 then begin repeat b:=pos(d,a); if b<>0 then delete(a,b,1); until b=0; Edit1.Text:=a;//а вот и строка где только по одному пробелу! end else Edit1.Text:=a;//это если везде по одному пробелу!

MAN-In-RED (2003-01-27 21:14:00) [99]

> Song © (27.01.03 21:07)

Оно та пройдет, только если строго два пробела между словами, а автор ветки говорит, что количество пробелов между двумя словами неизвестно, вот так ;)

Song (2003-01-27 21:07:00) [100]
S:=StringReplace(S,#32#32,#32,[rfReplaceAll]);
вот так попробуй, мне даже самому интересно, пройдёт или нет.

Страницы: < 1 2 3 4 5 6 >

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »