мастера, помогите, 2 часа бъюсь над проблемой, есть строка

← →
Layner (2003-08-25 11:38) [0]

"Один;Два;Три;Четыре;Пять;Шесть;". Каждое слово отделяет точка с запятой. Нужно получить слово, по порядковому номеру, т.е. сделать ф-ю, где входной парамер цифра, а возврашает ф-я слово из этой строки. Т.е. например get_slovo_func(5) возвратит слово "Пять" , get_slovo_func(3) возвратит слово "Три" и т.п.

Я сделал ф-ю возвращающая кол-во слов,

function TForm1.get_num_bd(Stroka: string): Integer; var i:integer; begin Result:=0; for i:=0 to Length(Stroka) do if Copy(Stroka,i,1)=";" then Result:=Result+1; end;

← →
Layner (2003-08-25 11:40) [1]

А по порядковому номеру не могу... Помогите разобраться, работаю только с ф-ми Pos, Copy, Delete

← →
Palladin © (2003-08-25 11:42) [2]

1
result:=0;
while pos(";",Stroka)<>0 do
begin
result:=result+1;
stroka:=copy(stroka,pos(";",stroka)+1,length(stroka);
end;

2
result:=0;
for i:=1 to length(stroka) if stroka[i]=";" then result:=result+1;

← →
MBo © (2003-08-25 11:42) [3]

TStringList.DelimitedText

← →
Palladin © (2003-08-25 11:43) [4]

найди по одной ошибке в каждом куске :)

← →
snake1977 (2003-08-25 11:45) [5]

n-номер лексемы
s-строка исходник
l-разделитель лексем в твоем случае ";"
Function GetLex(n:Integer; s:String; l:String):String;
Var i:Integer;
lx,st:String;
Begin
If S<>"" Then
Begin
lx:="";
i:=1;
st:=s;
Delete(st,Length(l)+1,Length(st)-Length(l));
While (st<>l) and (s<>"") do
Begin
lx:=lx+s[1];
Inc(i);
Delete(s,1,1);
st:=s;
Delete(st,Length(l)+1,Length(st)-Length(l));
End;
Delete(s,1,Length(l));
If n>1 Then lx:=GetLex(n-1,s,l);
End
Else
lx:="";
GetLex:=lx;
End;

← →
Polevi © (2003-08-25 11:51) [6]

Function GetLex(n:Integer; s:String; l:String):String;
var
sl:TStringList;
begin
sl:=TStringList.Create;
try
sl.Text:=StringReplace(s,l,#13#10,[rfReplaceAll]);
Result:=sl[n];
finally
sl.Free;
end;
end;

← →
Layner (2003-08-25 11:51) [7]

Спасибо! Уже пробую 2 способами, Palladin и snake1977.

← →
Layner (2003-08-25 11:58) [8]

Polevi © (25.08.03 11:51)
Самый компактный код, его и использую!! Большущее спасибо, как и всем откликнувшимся!!!!!!!!!!!

← →
Palladin © (2003-08-25 12:00) [9]

а я то думал ты со строками учишься работать...

Function GetLex(n:Integer; s:String; l:String):String;
begin
with TStringList.Create do
try
Text:=StringReplace(s,l,#13#10,[rfReplaceAll]);
Result:=Items[n];
finally
Free;
end;
end;

← →
Мастаки (хором) (2003-08-25 12:06) [10]

>>Layner (25.08.03 11:51) [7]
попробуй способом MBo © (25.08.03 11:42) [3] :-)
Зачем городить огород - все давно реализовано :-)

← →
Palladin © (2003-08-25 12:07) [11]

если разделитель один то конечно MBo, если разделителем строка, то звиняйте...

Palladin © (25.08.03 12:07) [11]

Если неправильно указать разделитель, то и ваш с Polevi вариант не прокатит.
GetLex(2,"w1,w2,w3,w4,w5",";")
Вышибет по "List Index Out of bounds"

Под каждый конкретный случай нужно подбирать подходящее решение.

← →
George Karkuzashvili (2003-08-25 13:55) [14]

Смею предложить компонент из моей библиотеки:

В ствойство Text - Исходный текст
В свойство Delimiter - Разделитель
в Свойство Part - Номер

Функция Activate - Сделает все что надо

То что надо достаем из свойства Substring

Успеха!

unit TextFunctions; interface uses SysUtils, Classes; type TPatternMode = (qspmPatternCount,qspmPatternSubstitute); TPatternCount = class(TComponent) private FText: TStrings; FSearchString: String; FReplaceString: String; FCount: Integer; FStringIndex : Integer; FActiveMode : TPatternMode; procedure SetSearchString(const Value: String); procedure SetText(const Value: TStrings); procedure SetStringIndex(const Value: Integer); procedure SetActiveMode(const Value: TPatternMode); procedure SetReplaceString(const Value: String); { Private declarations } protected { Protected declarations } public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Count: Integer read FCount; procedure Activate; { Public declarations } published property ActiveMode : TPatternMode read FActiveMode write SetActiveMode default qspmPatternCount; property Text: TStrings read FText write SetText; property SearchString: String read FSearchString write SetSearchString; property ReplaceString: String read FReplaceString write SetReplaceString; property StringIndex: Integer read FStringIndex write SetStringIndex default -1; { Published declarations } end; TPartitionString = class(TComponent) private FDelimiter: String; FText: String; FPart: Integer; FSubstring: String; procedure SetDelimiter(const Value: String); procedure SetPart(const Value: Integer); procedure SetText(const Value: String); protected public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Substring: String read FSubstring; procedure Activate; published property Delimiter: String read FDelimiter write SetDelimiter; property Text: String read FText write SetText; property Part: Integer read FPart write SetPart; end; procedure Register; implementation procedure Register; begin RegisterComponents("QSL Text Functions", [TPatternCount,TPartitionString]); end; { TPatternCount } procedure TPatternCount.Activate; var s : TStrings; i,ii : Integer; a : String; begin a := ""; s := TStringList.Create; s.Assign(FText); FCount := 0; if FText.Count = 0 then Exit else begin if FSearchString = "" then begin FCount := -1; Exit; end else begin for i := 0 to FText.Count - 1 do begin if FStringIndex = -1 then ii := i else ii := FStringIndex; if ii = i then while Pos(FSearchString,s[i]) > 0 do begin Inc(FCount); a := s[i]; if FActiveMode = qspmPatternCount then delete(a,1, Pos(FSearchString,a) + Length(FSearchString) - 1); if FActiveMode = qspmPatternSubstitute then begin a := StringReplace(a,FSearchString,FReplaceString,[rfReplaceAll]); If a <> FText.Strings[i] then FText.Strings[i] := a; end; s[i] := a; end; end; end; end; s.Clear; end; constructor TPatternCount.Create(AOwner: TComponent); begin inherited Create(AOwner); FText := TStringList.Create; FStringIndex := -1; FActiveMode := qspmPatternCount; end; destructor TPatternCount.Destroy; begin FText.Free; inherited Destroy; end; procedure TPatternCount.SetActiveMode(const Value: TPatternMode); begin if FActiveMode <> Value then FActiveMode := Value; end; procedure TPatternCount.SetReplaceString(const Value: String); begin FReplaceString := Value; end; procedure TPatternCount.SetSearchString(const Value: String); begin if FSearchString <> Value then FSearchString := Value; end; procedure TPatternCount.SetStringIndex(const Value: Integer); begin if FStringIndex <> Value then FStringIndex := Value; end; procedure TPatternCount.SetText(const Value: TStrings); begin FText.Assign(Value); end; { TPartitionString } procedure TPartitionString.Activate; var i : Integer; s : String; begin FSubstring := ""; s := FText; for i := 1 to FPart - 1 do begin delete(s,1, Pos(FDelimiter,s) + Length(FDelimiter) - 1); end; if Pos(FDelimiter,s) = 0 then FSubstring := s else FSubstring := Copy(s,1,Pos(FDelimiter,s) - 1); end; constructor TPartitionString.Create(AOwner: TComponent); begin inherited Create(AOwner); FDelimiter := ";"; end; destructor TPartitionString.Destroy; begin inherited Destroy; end; procedure TPartitionString.SetDelimiter(const Value: String); begin if FDelimiter <> Value then FDelimiter := Value; end; procedure TPartitionString.SetPart(const Value: Integer); begin if Value < 1 then FPart := 1 else FPart := Value; end; procedure TPartitionString.SetText(const Value: String); begin if FText <> Value then FText := Value; end; end.

← →
George Karkuzashvili (2003-08-25 14:00) [15]

Извиняюсь, забыл указать нужный компонент - TPartitionString

С уважением,

Георгий

MBo - рулез форева.
А то километры кода расписали уже...

мастера, помогите, 2 часа бъюсь над проблемой, есть строка Найти похожие ветки