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

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

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

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

Страницы: 1 2 >
Dr. Andrew © (2006-05-10 15:23:00)
Мастера, пожалуйста, подскажите алгоритм возвращения порядкового номера слова в строке (для меня желательно в WideString). Как можно создать такой алгоритм, например, function GetNumWord(WStr : WideString; Word : Widestring) : Integer, где WStr - строка в которой находится слово Word. И как быть, если это слово в одной и той же форме может повторяться в строке? Нужен последовательный порядковый номер слова в строке, например - "эта строка содержит слова и эти слова в этой строке." Здесь слова "слова" имеют порядковые номера 4 и 7. Всем спасибо, особенно за конкретный пример или ссылку на конкретный алгоритм.

Dr. Andrew (2006-05-10 20:33:00) [1]
Всем спасибо! Вроде бы получается. Остальное попробую доработать самостоятельно.

Loginov Dmitry (2006-05-10 20:25:00) [2]
Вы что, компонент написать хотите?

Насколько понял [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;

Dstr (2006-05-10 19:47:00) [3]

> А как реализовать правильно Вашу мысль - "Хотя проще вместо
> 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;

Dstr (2006-05-10 19:46:00) [4]
Кстати я думаю в вашей теме понадобится статейка:
Текст выглядит лучше, если он выровнен по двух краям. Для этого пробелы в каждой строке нужно удлинять или укорачивать так, чтобы все строки имели одну длину.

Здесь создана процедура 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;

Dr. Andrew (2006-05-10 19:36:00) [5]
Dstr

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

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

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

Dstr (2006-05-10 19:27:00) [6]
Можно тупо отсеч текст после курсора и подсчитать количество пробелов

Dr. Andrew (2006-05-10 19:18:00) [7]
Loginov Dmitry
Алгоритм возвращения порядкового номера слова в тексте. Например в тексте есть 10 слов. В возрастающем порядке каждое из них имеет свой порядковый номер. Вот мне -то его и необходимо возвратить.

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

Dstr (2006-05-10 19:12:00) [8]
1.Попробуй использовать мою функцию,вводя целые числа
2.Если получится используй Api функцию GetCurrentPosition

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

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

Dr. Andrew (2006-05-10 18:58:00) [10]
вначале курсор в произвольной позиции в пределах слова, а затем это слово выделяется. Только те фукции пока не работают, к сожалению.

Dstr (2006-05-10 18:57:00) [11]

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

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

Dr. Andrew (2006-05-10 18:56:00) [12]
Спасибо. А в практической реализации алгоритма? Есть еще решения? Может где-то выложен подобный алгоритм?

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

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

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

Loginov Dmitry (2006-05-10 18:45:00) [14]
Может еще какая мысль возникнет - не откажите записать ее на эту страницу.

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

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

Jeer (2006-05-10 18:20:00) [15]

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

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

Dr. Andrew (2006-05-10 18:14:00) [16]
Word_Count - компиллятор пишет ошибка. Функция в целом (NumWorld) не хочет работать. В качестве параметра Pos: Integer в ней я ставлю параметр Х из обработчика события onMouseDown (RichEdit). Что не верно?

Dstr (2006-05-10 18:06:00) [17]
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:01:00) [18]
А что надо конкретно изменить и где?

Dstr (2006-05-10 18:00:00) [19]
Хотя проще вместо Delete использовать SetLength,Я токо про нее вспомнил :)

Dr. Andrew (2006-05-10 18:00:00) [20]
Сейчас попробую. Необходимо этот алгоритм в поиской системе по историям болезни детей со злокачественными заболеваниями крови. Вот мне то и надо по аналогии с текстом "Война и мир" все 515 порядковых номеров слова "война" при выделении его по тексту. Спасибо за помощь. Может еще какая мысль возникнет - не откажите записать ее на эту страницу.

Страницы: 1 2 >

Наверх

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