Форум: "Основная";
Текущий архив: 2002.04.08;
Скачать: [xml.tar.bz2];

Вниз

Мастера, помогите с написанием функции удаления лишних пробелов в строке,   Найти похожие ветки 

← →
Yuraz   (2002-03-27 08:20) [0]

т.е. если в строке более 2х пробелов, убирается последний, между словами остаётся один пробел, если их было более одного. Что то совсем запутался, заранее благодарен за помощь.

{------------------------------------------------------------------------------}
function Del_13_Str(s : string): string;
{------------------------------------------------------------------------------}
var
a1: integer;
flag:boolean;
begin
while (flag=false) do
begin
a1:=Pos(#13,s);
// один символ убирает нормально
begin
Delete(s,a1,1);
exit;
end;

if (Copy(s,a1,1)=#13) then // здесь организуется цикл
Delete(s,a1+1,1)
else flag:=false;
end;
Result := s;
end;

---

← →
Alx2   (2002-03-27 08:27) [1]

Удаляет подряд идущие пробелы, оставляя только один из них. Также удаляются все пробелы в начале и в конце.

Procedure DelSpaces(Var S: String);
Var K, L: Integer;
Begin
If S = "" Then exit;
L := 1;
While L <= Length(S) Do
Begin
If S[L] <> " " Then break;
inc(L);
End;
If L > Length(S) Then
Begin
SetLength(S, 0);
exit;
End;
If L > 1 Then
S[1] := S[L];
K := L + 1;
L := 1;
For K := K To Length(S) Do
Begin
If (S[L] <> " ") Or (S[K] <> " ") Then
Begin
inc(L);
S[L] := S[K];
End;
End;
If S[L] <> " " Then
SetLength(S, L) Else
SetLength(S, L - 1);
End;


Более наглядный, но и более тормозной вариант на основе Pos может выглядеть так:

While Pos(" ",S)>0 do StringReplace(S," "," ",[rfReplaceAll]);

---

← →
Alx2   (2002-03-27 08:28) [2]

>Yuraz © (27.03.02 08:20)
Речь идет о пробелах, но почему в твоем коде #13?

---

← →
deleon   (2002-03-27 08:32) [3]

Скачай модуль QStrings.pas - самый мощный и быстрый модуль для работы со строками и не только! И не мучайся (есть там и эта функция)!
http://www.dbwork.kuban.ru/download/qstrings.zip

---

← →
Digitman   (2002-03-27 08:37) [4]

ф-ция совмещает в себе LTrim, RTrim и удаляет лишние пробелы между словами. Интенсивно используется мной в IB UDF. Думаю, не будет проблем доработать ее для передачи/возврата строк в формате String

Результат - указатель на ту же строку, но - с преобразованным по указанной логике содержимым.


function DelSpaces(Src: PChar): PChar;
var
i,j,c,f: Integer;
k: Boolean;
begin
i:= 0;
j:= 0;
c:= 0;
f:= 0;
k:= False;
while Src[i] <> #0 do begin
if Src[i] <> " " then begin
if not k then begin
k:= True;
c:= 0;
Inc(f);
end;
if i > j then Src[j]:= Src[i];
Inc(j);
end else begin
if k then begin
k:= False;
if i > j then Src[j]:= Src[i];
Inc(j);
end else begin
if (f > 0) and (c = 0) then begin
if i > j then Src[j]:= Src[i];
Inc(j);
end;
end;
Inc(c);
end;
Inc(i);
end;
if c > 0 then Dec(j);
Src[j]:= #0;
Result:= Src;
end;


---

← →
Yuraz   (2002-03-27 08:53) [5]

О, ещё раз спасибо! QStrings.pas(669кб) есть, просто хотелось стандартными средствами.

---

← →
USAtyj   (2002-03-27 09:47) [6]

Если у тебя есть RXLib, то там есть модуль strutils - там куча полезных функций, в том числе и то, что тебе надо.
Посмотри как оно сделано там и сделай себе также "стандартнымми средствами".

---

← →
Alx2   (2002-03-27 09:53) [7]

>USAtyj © (27.03.02 09:47)
Там (в RxLib) довольно неэффективная реализация:
function DelSpace1(const S: string): string;
var
I: Integer;
begin
Result := S;
for I := Length(Result) downto 2 do begin
if (Result[I] = " ") and (Result[I - 1] = " ") then
Delete(Result, I, 1);
end;
end;

---

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

Форум: "Основная";
Текущий архив: 2002.04.08;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.006 c