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

Вниз

совет по алгоритму...   Найти похожие ветки 

← →
MetalFan   (2003-03-27 10:21) [0]

задача
нужна процедура вида AnyProc(AStr,ASeparator,ANewSubStr,APos);
где
AStr вида "111*222*333*444*555**"
ASeparator - 1 символ(в данном случае "*")
ANewSubStr - ну допустим "NewStr"
APos>0 (допустим =2)
которая заменяет подстроку в позиции относительно разделителя
новой подстрокой.
т.е. в результате получаем "111*NewStr*333*444*555**"
вот что полцчилось у меня:


procedure SetPiece(var AStr:string;ASeparator,NewSubStr:String;APos:integer=1);
var
I,J:integer;
str1:string;
FlgFnd:boolean;
SepLngth:integer;
begin
if ASeparator="" then begin AStr:=NewSubStr; exit end;
str1:="";J:=1;flgFnd:=true;
SepLngth:=SLength(AStr,ASeparator);
if APos>SepLngth then
str1:=AStr +DupeString(ASeparator,APOs-SepLngth)+NewSubStr
else
for I:=1 to length(AStr) do begin
if (j=Apos)and FlgFnd then begin
if APos=SepLngth then str1:=str1+Newsubstr;
if APos<SepLngth then str1:=str1+Newsubstr+ASeparator;
FlgFnd:=false;
end;
if (j<>apos) then str1:=str1+copy(AStr,i,1);
if copy(AStr,i,1)=ASeparator then inc(J);
end;//for
AStr:=Str1;
end;//proc

function SLength(STR:String;SYMB:String=""):Integer; //аналог $L MSM
var
X:Integer;
begin
Result:=Length(STR);
if Symb="" then exit;
Result:=1;
For X:=1 to Length(STR) do
if copy(STR,X,1)=SYMB then inc(RESULT);
end;//func

кто что еще предложит???
спасибо за внимание)))

---

← →
Palladin   (2003-03-27 10:27) [1]

я предложу...
StringReplace + F1

---

← →
MetalFan   (2003-03-27 10:43) [2]

> Palladin © (27.03.03 10:27)

нет, вы не так поняли...
мне нужно заменить подстроку в определенной позиции относительно
разделителей, зная только номер этой позиции...
приведу примеры:
AStr="pole1*pole2*pole3*pole4*pole5"
ASep="*"
NewSubStr="newStr";
1) APos=1, результат = "newStr*pole2*pole3*pole4*pole5"
2) APos=3, результат = "pole1*pole2*newStr*pole4*pole5"
3) APos=6, результат = "pole1*pole2*newStr*pole4*pole5*newStr"
вот...
кто что еще посоветует?

---

← →
REA   (2003-03-28 13:13) [3]

1) while posex, Insert
2) можно попробовать TStringList.DelimitedText, Insert, Text

---

← →
MetalFan   (2003-03-28 14:26) [4]

> REA ©

попробывал так:
procedure SetPiece(var AStr:string;ASeparator,NewSubStr:String;APos:integer=1);
var
StrLst:TStringList;
begin
StrLst:=TStringList.Create;
StrLst.Delimiter:=Aseparator[1];
StrLst.DelimitedText:=AStr;
if APOs>StrLst.Count then
while StrLst.Count<Apos do StrLst.Add("");
StrLst[APos-1]:=NewSubStr;
AStr:=StrLst.DelimitedText;
StrLst.Free;
end;//proc

вроде намана получилось)

---

← →
Shc   (2003-03-29 17:20) [5]

Или ещё:

procedure SetPiece(var AStr:string;ASeparator,NewSubStr:String;APos:integer=1);
var
k,n:integer;
st,s:string;
begin
if ASeparator="" then begin AStr:=NewSubStr; exit end;
s:="";st:=astr;
k:=pos(Aseparator,st);
if k>0 then n:=1 else n:=0;
while (n<=apos-1) and (k>0) do
begin
s:=s+copy(st,1,k);
delete(st,1,k+length(Aseparator)-1);
k:=pos(Aseparator,st);
if k>0 then n:=n+1;
end;
case n of
Apos : Astr:=s+NewSubStr+copy(st,k,length(st)-k+1);
Apos-1: Astr:=s+NewSubStr;
end;
end;

Вроде должно работать, но не проверял.

---

← →
einsam   (2003-04-02 01:40) [6]

Можно еще сделать вот так:

procedure SReplace(var AStr: string; const ASeparator: char; const ANewSubStr: string; const APos: integer);
var OldStr: string;
Pos: integer;
i: integer;
Inserted: boolean;
begin
Pos := 1;
OldStr := AStr;
AStr := "";
Inserted := False;
for i := 1 to Length(OldStr) do
begin
if Pos = APos then
begin
if not Inserted then AStr := AStr + ANewSubStr + ASeparator;
Inserted := True;
end else AStr := AStr + OldStr[i];
if OldStr[i] = ASeparator then Pos := Pos + 1;
end;
if Pos = APos then AStr := AStr + ANewSubStr;
if Pos + 1 = APos then AStr := AStr + ASeparator + ANewSubStr;
end;

---

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

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

Наверх

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