Как создать алгоритм возвращения поряд. номера слова в строке.

← →
Dr. Andrew (2006-05-10 15:23) [0]

Мастера, пожалуйста, подскажите алгоритм возвращения порядкового номера слова в строке (для меня желательно в WideString). Как можно создать такой алгоритм, например, function GetNumWord(WStr : WideString; Word : Widestring) : Integer, где WStr - строка в которой находится слово Word. И как быть, если это слово в одной и той же форме может повторяться в строке? Нужен последовательный порядковый номер слова в строке, например - "эта строка содержит слова и эти слова в этой строке." Здесь слова "слова" имеют порядковые номера 4 и 7. Всем спасибо, особенно за конкретный пример или ссылку на конкретный алгоритм.

← →
Сергей М. © (2006-05-10 15:34) [1]

> Как создать алгоритм возвращения поряд. номера слова в строке

Каком кверху.

ТЗ готовь.

← →
Dr. Andrew (2006-05-10 15:42) [2]

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

← →
Dstr © (2006-05-10 16:04) [3]

//Разделить строку S на слова используя разделительный символ Delimeter
//и поместить результат в TStrings
procedure StrBreakApart(const S, Delimeter: string; Parts: TStrings);
var
CurPos: integer;
CurStr: string;
begin
Parts.clear;
Parts.BeginUpdate();
try
CurStr := S;
repeat
CurPos := Pos(Delimeter, CurStr);
if (CurPos > 0) then
begin
Parts.Add(Copy(CurStr, 1, Pred(CurPos)));
CurStr := Copy(CurStr, CurPos + Length(Delimeter),
Length(CurStr) - CurPos - Length(Delimeter) + 1);
end
else
Parts.Add(CurStr);
until CurPos = 0;
finally
Parts.EndUpdate();
end;
end;

//поиск слова ета функция написана мной сейчас "на скорую руку"
procedure SelWord(Where: String;What: Integer): String;
Var Tmp: TStringList;
Begin;
Tmp := TStringList.Create;
StrBreakApart(Where, " ", Tmp);
Result := Tmp.Strings[What + 1];
End;

//Если у тебя многострочный текст - Создаешь временую строку,помешаешь туда текст и заменяешь \n\r или \r\n на пробелы и реализуешь то что я написал

← →
Dr. Andrew (2006-05-10 16:06) [4]

Спасибо Dstr! Сейчас попробую. А можно с Вами держать связь по e-mail?

← →
Dstr © (2006-05-10 16:12) [5]

Не,лучше ICQ 209-298-286

← →
Dr. Andrew (2006-05-10 16:20) [6]

Dstr.

Функция SelWord возвращает слово по его порядковому номеру и то неверно, почему-то, а у меня совсем другая задача. Возвращать порядковый номер слова в тексте, например - "Это мой текст и я его написал.", где "Это" - 1, "мой" - 2, "текст" - 3 ... "написал" - N.

← →
Dr. Andrew (2006-05-10 16:22) [7]

Спасибо. ICQ не имею и не уважаю, как программу. Извините - у каждого свои пристрастия. :-) Может тогда посмотрите на мою задачу с нового угла зрения. Номер слова нужен по тексту, а не слово в тексте по номеру.

← →
Jeer © (2006-05-10 16:40) [8]

Dr. Andrew (10.05.06 16:20) [6]

определись с понятием "слово" и "разделитель(и)" слов.
Все сразу станет на место.
Позиция символа в строке - pos()

← →
Dstr © (2006-05-10 16:48) [9]

ААааа,ну ето эшо проще:

function GetWord(Str, Smb: string; WordNmbr: Byte): string; var SWord: string; StrLen, N: Byte; begin StrLen := SizeOf(Str); N := 1; while ((WordNmbr >= N) and (StrLen <> 0)) do begin StrLen := Pos(Smb, str); if StrLen <> 0 then begin SWord := Copy(Str, 1, StrLen - 1); Delete(Str, 1, StrLen); Inc(N); end else SWord := Str; end; if WordNmbr <= N then Result := SWord else Result := ""; end;

//А вот так используйте GetWord("Здесь ваш текст"," ",3); // Возвращает -> "текст"

А вот насчет ICQ ето зря,ведь RealTime куда лучше чем етот Email...Я сам в протоколе разбырался аси,он кривой конечно,но зато работает,и работает быстро.В прогах я всегда уважаю быстроту больше красотулек...

← →
Dr. Andrew (2006-05-10 17:11) [10]

Нет, Вы не совсем правильно истолковали вопрос. Да, GetWord действительно возвратит третье слово из строки или текста. Но мне неоходимо, например в обработчике события onMouseDown, чтобы при щелчке на слове "текст" я получил как результат этой функцииего порядковый номер, то есть число 3. теперь более понятнее я написал. А функция Pos мне не годится, потому что она возвращает символы слова, а не порядковый номер слова. Спасибо всем за участие и жду новых решений.

← →
Jeer © (2006-05-10 17:14) [11]

Dr. Andrew (10.05.06 17:11) [10]

> и жду новых решений.

А самому поработать ?

← →
Dr. Andrew (2006-05-10 17:22) [12]

С огромным удовольствием, если бы было над чем.

← →
Dr. Andrew (2006-05-10 17:22) [13]

С огромным удовольствием, если бы было над чем.

← →
Dr. Andrew (2006-05-10 17:27) [14]

Jeer! Я ведь обращаюсь к профессионалам, мастерам. Для того это и форум, чтобы найти мысль, на которую тебя натолкнут. Пока такой мысли нет. И я не профессиональный программист, а детский врач. И необходимость в коде по моей работе (это долго объяснять). У врачей теперь тоже есть компьютеры и они немного программируют для себя и своих пациентов. Так что может кто-то из мастеров все же поможет отечественной науке?

← →
Dstr © (2006-05-10 17:31) [15]

> Нет, Вы не совсем правильно истолковали вопрос. Да, GetWord
> действительно возвратит третье слово из строки или текста.
> Но мне неоходимо, например в обработчике события onMouseDown,
> чтобы при щелчке на слове "текст" я получил как результат
> этой функцииего порядковый номер, то есть число 3. теперь
> более понятнее я написал. А функция Pos мне не годится,
> потому что она возвращает символы слова, а не порядковый
> номер слова. Спасибо всем за участие и жду новых решений

Ой,извини я сегодня чето тормажу,
Тогда используешь также StrBreakApart и в цикле сравнивай Строки Из TstringList С твоим словом...

← →
Jeer © (2006-05-10 17:35) [16]

Ок.
В тексте объемом с "Война и мир" слово война встречается 515 раз и каждое из них имеет свою позицию, т.е. имее 515 чисел.
Вам в каком виде надо это представить и кому ?

← →
Dstr © (2006-05-10 17:54) [17]

А ты блин прав,Токгда мош ето подойдет?:

function Seps(As_Arg: Char): Boolean;
begin
Seps := As_Arg in
[ #0..#$1F, " ", ".", ",", "?", ":", ";", "(", ")", "/", "\"];
end;

function WordCount(CText: string): Longint;
var
Ix: Word;
Work_Count: Longint;
begin
Work_Count := 0;
Ix := 1;
while Ix <= Length(CText) do
begin
while (Ix <= Length(CText)) and (Seps(CText[Ix])) do
Inc(Ix);
if Ix <= Length(CText) then
begin
Inc(Work_Count);

while (Ix <= Length(CText)) and (not Seps(CText[Ix])) do
Inc(Ix);
end;
end;
Word_Count := Work_Count;
end;

Function NumWorld(S: String; Pos: Integer): Longint; //Ну если ето не поможет,то не знаю,Нужно конечно указать позицию курсора в Pos
Begin;
Delete(S, Pos, Length(S) - Pos);
Result := WordCount(S);
End;

← →
Dr. Andrew (2006-05-10 18:00) [18]

Сейчас попробую. Необходимо этот алгоритм в поиской системе по историям болезни детей со злокачественными заболеваниями крови. Вот мне то и надо по аналогии с текстом "Война и мир" все 515 порядковых номеров слова "война" при выделении его по тексту. Спасибо за помощь. Может еще какая мысль возникнет - не откажите записать ее на эту страницу.

← →
Dstr © (2006-05-10 18:00) [19]

Хотя проще вместо Delete использовать SetLength,Я токо про нее вспомнил :)

← →
Dr. Andrew (2006-05-10 18:01) [20]

А что надо конкретно изменить и где?

← →
Dstr © (2006-05-10 18:06) [21]

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
find: string;
text: string;
st, len: integer;
res: integer;
begin
if Memo1.SelStart >= Length(Memo1.Text) then
Memo1.SelStart := 0;
st := Memo1.SelStart + 1;
if (Memo1.SelLength <= 0) or (not CheckBox1.Checked) then
begin
inc(st, Memo1.SelLength);
len := Length(Memo1.Text) - st;
end
else
len := Memo1.SelLength;
text := copy(Memo1.Text, st, len);
find := Edit1.Text;
res := pos(find, text);
if res = 0 then
begin
ShowMessage("Search string "" + find + "" not found");
Exit;
end;
Memo1.SelStart := res + st - 2;
Memo1.SelLength := length(find);
end;

Вот эшо статья из delphiWorld"Как реализовать поиск по тексту"
Разбераться я в ней не буду - я и так забыл про свой проект блин,и даю тебе возможность разобраться самому

← →
Dr. Andrew (2006-05-10 18:14) [22]

Word_Count - компиллятор пишет ошибка. Функция в целом (NumWorld) не хочет работать. В качестве параметра Pos: Integer в ней я ставлю параметр Х из обработчика события onMouseDown (RichEdit). Что не верно?

← →
Jeer © (2006-05-10 18:20) [23]

> Необходимо этот алгоритм в поиской системе по историям

Задача все усложняется.
Не вдаваясь в подробности по организации такой поисковой системы, решение может быть таким:
- есть куча текстовый файлов с описаниями
- загружаем один в мемо
- выделяем мышкой нужное слово и копируем в переменную s: string
- далее, составляем список оставшихся файлов, перебираем файлы и читаем
каждый построчно
- каждая строка "бьется" на слова и среди них ищется искомое
- каждый удачный поиск добавляет новую позицию в динамический массив arPos array of integer, предварительно увеличивая его длину на 1 с помощью SetLength(arPos, Length(arPos) + 1)

← →
Loginov Dmitry © (2006-05-10 18:45) [24]

Может еще какая мысль возникнет - не откажите записать ее на эту страницу.

Мысля 1: оставить Delphi в покое, и пользоваться известными средствами: MS Word, Notepad, и т.д. Там кстати даже поиск реализован.

Мысля 2: см [11]

← →
Loginov Dmitry © (2006-05-10 18:46) [25]

Dr. Andrew (10.05.06 18:00) [18]
Может еще какая мысль возникнет - не откажите записать ее на эту страницу.

Мысль 1: Оставить Delphi в покое, и пользоваться известными средствами: MS Word, Notepad (там кстати даже поиск есть).

Мысль 2: см [11]

← →
Dr. Andrew (2006-05-10 18:56) [26]

Спасибо. А в практической реализации алгоритма? Есть еще решения? Может где-то выложен подобный алгоритм?

> Word_Count - компиллятор пишет ошибка. Функция в целом (NumWorld)
> не хочет работать. В качестве параметра Pos: Integer в ней
> я ставлю параметр Х из обработчика события onMouseDown (RichEdit).
> Что не верно?

Правильно блин - Он тебе курсор мыши и выдаст блин по отношению к форме, ща подумаю че можно придумать чтобы определить позицию мерцающего курсора,или у вас выделение?

← →
Dr. Andrew (2006-05-10 18:58) [28]

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

Dr. Andrew (10.05.06 18:56) [26]
Может где-то выложен подобный алгоритм?

Какой алгоритм? Что вам нужно, объясните толком, и что вы будете делать с тем, что получится?

1.Попробуй использовать мою функцию,вводя целые числа
2.Если получится используй Api функцию GetCurrentPosition

← →
Dr. Andrew (2006-05-10 19:18) [31]

Loginov Dmitry
Алгоритм возвращения порядкового номера слова в тексте. Например в тексте есть 10 слов. В возрастающем порядке каждое из них имеет свой порядковый номер. Вот мне -то его и необходимо возвратить.

Dstr
Пробую, но пока ничего не выходит. Да и мне необходимо кк-то оттолкнуться от обработчика события onMouseDown или onMouseUp.

Можно тупо отсеч текст после курсора и подсчитать количество пробелов

← →
Dr. Andrew (2006-05-10 19:36) [33]

Dstr

Что-то вроде получается.
А как реализовать правильно Вашу мысль - "Хотя проще вместо Delete использовать SetLength,Я токо про нее вспомнил":

Function NumWorld(S: String; Pos: Integer): Longint;
Begin;
Delete(S, Pos, Length(S) - Pos);
Result := WordCount(S);
End;

Как правильно будет выглядеть тогда код функции NumWorld?
Спасибо всем Мастерам за помощь и Вам в частности!

Кстати я думаю в вашей теме понадобится статейка:
Текст выглядит лучше, если он выровнен по двух краям. Для этого пробелы в каждой строке нужно удлинять или укорачивать так, чтобы все строки имели одну длину.

Здесь создана процедура GetLine, которая возвращает одну строку, начиная с заданного символа. Программа находит разницу между шириной текста и реальной длинной строки и при выводе компенсирует эту разницу удлинением пробелов.

Эта программа выводит на экран текст из файла C:\text.txt, выравнивая его по двум краям.

type
...
TLine = record
s: string;
wrap: boolean;
length: integer;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const
FileName = "C:\text.txt";

var
s: string;
bm: TBitMap;
LineH: integer;
MaxTextWidth: integer;

procedure TForm1.FormCreate(Sender: TObject);
var
F: TFileStream;
buf: array [0..127] of char;
l: integer;
begin
ScrollBar1.Kind := sbVertical;
bm := TBitMap.Create;
with bm.Canvas.Font do
begin
name := "Serif";
Size := 12;
end;
LineH := bm.Canvas.TextHeight("123");

if not FileExists(FileName) then
begin
ShowMessage("Can not find file " + FileName);
Exit;
end;
F := TFileStream.Create(FileName, fmOpenRead);
repeat
l := F.read(buf, 128);
if l = 128 then
s := s + buf
else
s := s + copy(buf, 1, l);
until
l < 128;
F.Destroy;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
PaintBox1.Left := 0;
PaintBox1.Top := 0;
PaintBox1.Height := Form1.ClientHeight;
PaintBox1.Width := Form1.ClientWidth - ScrollBar1.Width;
ScrollBar1.Left := PaintBox1.Width;
ScrollBar1.Top := 0;
ScrollBar1.Height := PaintBox1.Height;
bm.Width := PaintBox1.Width;
bm.Height := PaintBox1.Height;
ScrollBar1.Max := 1000;
MaxTextWidth := PaintBox1.Width - 20;
end;

function RealTextWidth(s: string): integer;
var
i: integer;
begin
result := bm.Canvas.TextWidth(s);
for i := 1 to Length(s) do
if s[i] = #9 then
inc(result, 40 - bm.Canvas.TextWidth(#9));
end;

function GetLine(index: integer): TLine;
var
i: integer;
s1: string;
first: integer;
begin
if (s[index] = #13) and (s[index + 1] = #10) then
begin
result.s := "";
result.length := 2;
result.wrap := true;
Exit;
end;
first := index;
while (first <= Length(s)) and (s[first] in [ #32]) do
inc(first);
i := first;
repeat
while (i <= Length(s)) and (not (s[i] in [ #9, #32])) and (s[i] <> #13) do
inc(i);
s1 := copy(s, first, i - index);
inc(i);
until
(i >= Length(s)) or (s[i-1] = #13) or (RealTextWidth(s1) > MaxTextWidth);
if RealTextWidth(s1) > MaxTextWidth then
begin
result.wrap := false;
if i < Length(s) then
begin
dec(i, 2);
while (i > 0) and (not (s[i] in [ #9, #32])) do
dec(i);
result.Length := i - index;
while (i > 0) and (s[i] in [ #9, #32]) do
dec(i);
end;
result.s := copy(s, first, i - index + 1);
if result.s[length(result.s)] = #32 then
delete(result.s, length(result.s) , 1);
end
else
begin
result.length := i - index + 1;
s1 := copy(s, first, i - index + 1);
if length(s1) > 0 then
begin
if s1[Length(s1)] = #9 then
delete(s1, Length(s1), 1);
if s1[length(s1) - 1] + s1[length(s1)] = #13#10 then
delete(s1, length(s1) - 1, 2);
end;
result.s := s1;
result.wrap := true;
end;
end;

procedure draw;
var
i, j: integer;
line: TLine;
OneWord: string;
LineN: integer;
SpaceCount: integer;
TextLeft: integer;
shift, allshift: integer;
d: integer;
LineCount: integer;
begin
with bm.Canvas do
begin
FillRect(ClipRect);
i := 1;
LineCount := 0;
for j := 1 to Form1.ScrollBar1.Position do
begin
line := GetLine(i);
inc(i, line.length);
inc(LineCount);
end;
LineN := 0;
repeat
line := GetLine(i);
SpaceCount := 0;
TextLeft := 0;
for j := 1 to Length(line.s) do
if line.s[j] = #32 then
inc(SpaceCount);
if line.wrap = false then
allshift := MaxTextWidth - RealTextWidth(line.s)
else
allshift := 0;
if allshift > 40 * SpaceCount then
allshift := 0;
shift := 0;
for j := 1 to Length(line.s) do
begin
if (not (line.s[j] in [ #9, #32])) and (j < Length(line.s)) then
begin
OneWord := OneWord + line.s[j];
end
else
begin
OneWord := OneWord + line.s[j];
if OneWord = #9 then
begin
inc(TextLeft, 40);
end
else
begin
if OneWord = #13#10 then
begin
inc(LineN);
end
else
begin
TextOut(10 + TextLeft, LineN * LineH, OneWord);
if SpaceCount = 0 then
d := 0
else
d := (allshift - shift) div (SpaceCount);
inc(shift, d);
inc(TextLeft, TextWidth(OneWord) + d);
dec(SpaceCount);
end;
end;
OneWord := "";
end;
end;
inc(i, line.length);
inc(LineN);
until
(LineN * LineH > Form1.PaintBox1.Height) or (i >= Length(s));

repeat
line := GetLine(i);
inc(i, line.length);
inc(LineCount);
until
i >= Length(s);

inc(LineCount, LineN);
Form1.ScrollBar1.Max := LineCount -
Form1.PaintBox1.Height div LineH;
end;
Form1.PaintBox1.Canvas.Draw(0, 0, bm);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
draw;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
draw;
end;

> А как реализовать правильно Вашу мысль - "Хотя проще вместо
> Delete использовать SetLength,Я токо про нее вспомнил":
>
> Function NumWorld(S: String; Pos: Integer): Longint;
> Begin;
> Delete(S, Pos, Length(S) - Pos);
> Result := WordCount(S);
> End;
>
> Как правильно будет выглядеть тогда код функции NumWorld?
>
> Спасибо всем Мастерам за помощь и Вам в частности!

Вот так
Function NumWorld(S: String; Pos: Integer): Longint;
Begin;
SetLength(S, Pos);
Result := WordCount(S);
End;

Вы что, компонент написать хотите?

Насколько понял [31], для решения сабжа этого достаточно:

procedure TForm1.Button1Click(Sender: TObject); var List: TStringList; begin List := TStringList.Create; GetWordList(List); ShowMessage(IntToStr(List.IndexOf(Edit1.Text))); List.Free; end; procedure TForm1.GetWordList(List: TStrings); var S: string; I: Integer; const WordChars = ["a".."z", "A".."Z", "0".."9", "а".."я", "А".."Я", "ё", "Ё"]; begin S := Memo1.Text; for I := 1 to Length(S) do if not (S[I] in WordChars) then S[I] := " "; List.DelimitedText := S; end;

← →
Dr. Andrew (2006-05-10 20:33) [37]

Всем спасибо! Вроде бы получается. Остальное попробую доработать самостоятельно.

Как создать алгоритм возвращения поряд. номера слова в строке. Найти похожие ветки