Помощь - Поиск - Пользователи - Календарь
Полная версия: Замена слов по словарю
Форум «Всё о Паскале» > Delphi, Assembler и другие языки. > Delphi
Незнакомец
Здравствуйте. Не могли бы подсказать как сделать вот такую штуку: замешательство
в TMemo находится английский текст (например:
Цитата
Hello world

), как сделать так чо бы считывать слова и вставлять их перевод в др мемо из файла-словаря?
В файле слова находятса в таком виде:


..................
hello привет
..................
..................
world мир
...............



И результат получался бы типа такого:
Цитата
привет мир
Altair
все просто. Надо сначала слова выделить в memo, как это сделать читай в FAQе нашем... далее все очевидно...
Н
Цитата
Надо сначала слова выделить в memo

это, то есть считать их в массив, или я не правильно понял?
Malice
Цитата(Н @ 30.08.05 22:17)
это, то есть считать их в массив, или я не правильно понял?


Я бы не стал выделять слова, т.к. потом после замены придется их опять в строку клеить, да и все знаки запятые и проч. потеряются. Проще читать построчно, искать вхождение каждого слова через Pos и сразу заменять.
Правда придется добавить проверку, чтобы не было замен внутри слов, но это прсто smile.gif
Н
Цитата
Проще читать построчно, искать вхождение каждого слова через Pos и сразу заменять.
Правда придется добавить проверку, чтобы не было замен внутри слов


А как это сделать, можно пример?
volvo
Вот тебе работающий набросок на FPC, просто добавь построчное чтение из Memo в строку S и измени процедуру Replace_Word так, чтобы она меняла переданное ей слово на соотв. слово из файла-словаря:

procedure replace_word(s: string);
begin
write('(-', s, '-)'); { <--- замени на вывод во второй Memo }
end;

var
s: string = 'this ::is a, text';
next_word: string;
i: byte;

begin
i := 1; next_word := '';
while i <= length(s) do begin
if upcase(s[i]) in ['A'..'Z'] then begin
next_word := next_word + s[i]; inc(i)
end
else begin
if next_word <> '' then replace_word(next_word);
write(s[i]); { <--- замени на вывод во второй Memo }
next_word := ''; inc(i);
end;
end;

if next_word <> '' then replace_word(next_word);

end.

Как видишь, все разделители сохраняются... Кстати, эту программку можно еще оптимизировать ;)
Malice
Цитата(Н @ 31.08.05 11:39)
А как это сделать, можно пример?

Как то вот так:
for i:=1 to КолвоСловВсловаре do
for j:=0 to memo1.Lines.Count-1 do begin
p:=1;
while p>0 do begin
sT:=memo1.Lines.Strings[j]; p:=pos(word[i].en,st);
if p>0 then
memo1.Lines.Strings[j]:=copy(st,1,p-1)+word[i].ru+ copy(st,p+length(word[i].en),255);
end; end;

Н
Цитата
построчное чтение из Memo в строку S

блин не получается сделать, и найти не могу как делать ... sad.gif
Malice
Цитата(Н @ 31.08.05 14:50)
блин не получается сделать, и найти не могу как делать ... sad.gif


Ну так как у меня:
s:=memo1.Lines.Strings[j];

Строки нумируются с нуля.
volvo
For currLine := 0 To Pred(memo1.Lines.Count) Do Begin
s := memo1.Lines.Strings[currLine]
...
End;
Н
volvo, Malice Спасибо... smile.gif
Н
Цитата
Replace_Word так, чтобы она меняла переданное ей слово на соотв. слово из файла-словаря


Я открываю файл для чтения, а как дальше осуществить писк и замену S ?
hiv
Словарь лучше хранить в виде:
word=слово

Тогда чтение его и использование упрощается:
 var ER :TStrings;
. . .
// загрузка словаря
ER:=TStringList.Create;
ER.LoadFromFile('имя файла словаря');
. . .
// замена найденного английского слова на русское в переменной sw :string;
sw:=ER.Values[sw];
. . .

Вот и все. А как найти в строке все слова можно найти в FAQ.
Н
Цитата
как найти в строке все слова можно найти в FAQ.


Пересмотрел FAQ несколько раз но ничего подобного не нашел sad.gif ...
volvo
В каком FAQ-е искал? В Дельфийском? А в Паскалевском посмотреть не догадался? Синтаксис-то один и тот же smile.gif Вот тут (и в соседних постах) посмотри: FAQ: Строки

Хотя я тебе привел более подходящий для твоего случая алгоритм, сохраняющий все разделители, а функция из FAQ-а все разделители выбрасывает.
Н
Цитата
Хотя я тебе привел более подходящий для твоего случая алгоритм, сохраняющий все разделители, а функция из FAQ-а все разделители выбрасывает.


Я просто хотел доделать твой алгоритм, что бы происходил поиск, слов из считанной строки, в словаре и их замена...
hiv
Смотри пост 13. Лучше всетаки сделать проверку, что английское слово не найдено, тогда оно остается неизменным в тексте:
var ER :TStrings;
. . .
// загрузка словаря
ER:=TStringList.Create;
ER.LoadFromFile('имя файла словаря');
. . .
// замена найденного английского слова на русское в переменной sw :string;
sw_rus:=ER.Values[sw];
if sw_rus='' then sw_rus:=sw;
. . .
// освобождаем память, занятую словарем
ER.Free;
. . .
PS: Не забудь, что в английском есть сокращения с использованием апострофа, а также он используется в именах собственных в притяжательном склонении.
Н
Собрал все в одно, вот что получилось:



procedure replace_word(next_word: string);
var next_word_rus: string;
ER :TStrings;

begin
ER:=TStringList.Create;
ER.LoadFromFile('voc.txt');
next_word_rus:=ER.Values[next_word];
if next_word_rus='' then next_word_rus:=next_word;
Memo2.Lines.Add(next_word_rus);
er.free

end;

procedure TForm1.Button1Click(Sender: TObject);

var
s, next_word: string;
i: byte;
currLine: integer;

begin
For currLine := 0 To Pred(memo1.Lines.Count) Do Begin
s := memo1.Lines.Strings[currLine];
i := 1; next_word := '';
while i <= length(s) do begin
if upcase(s[i]) in ['A'..'Z'] then begin
next_word := next_word + s[i]; inc(i)
end
else begin
if next_word <> '' then replace_word(next_word);
Memo2.Lines.Add(s[i]);
next_word := ''; inc(i);
end;
end;

if next_word <> '' then replace_word(next_word);
end; end;



а он выдает такие ошибки:

[Error] 123.pas(41): Undeclared identifier: 'Memo2'
[Error] 123.pas(41): Missing operator or semicolon

что не так?
volvo
Цитата(Н @ 5.09.05 21:18)
а он выдает такие ошибки:

Ну, с этой ошибкой: " [Error] 123.pas(41): Undeclared identifier: 'Memo2' " довольно прозрачно: у тебя просто Memo2 принадлежит классу формы, но вот процедура replace_word - то не является методом этого класса, поэтому для нее Memo2 не существует...

А вот эта: " [Error] 123.pas(41): Missing operator or semicolon " исчезнет сама собой, как только будет исправлена первая, просто сейчас структура программы нарушена, и пока ее не восстановишь - дальше будут "наведенные" ошибки...
hiv
blink.gif Я не зря ставил многоточия в своем примере! В твоей программе при проверке каждого слова будет каждый раз грузиться файл словаря - это просто не нужно делать! Перенеси чтение словаря до начала перевода всех слов, а его уничтожение (освобождение памяти Free) после всего перевода.
Н
Вот я исправил, на мемо больше не ругается, но когда нажимаю перевод, вылетает сообщение об ошибке:

"Project Projectl.exe raised exception class EAccessViolation with message 'Access violation at address 00414988 in module 'Projectl.exe'. Read of address 00000004' Process stopped. Use Step or Run to continue."


"Access violation at address 00414988 in module 'Project1.exe'. Read of address 00000004."

И в итоге ни чего не переводит sad.gif ...



procedure TForm1.replace_word (next_word: string);
var next_word_rus: string;
ER :TStrings;

begin

next_word_rus:=ER.Values[next_word];
if next_word_rus='' then next_word_rus:=next_word;
Memo2.Lines.Add(next_word_rus);


end;

procedure TForm1.Button1Click(Sender: TObject);

var
s, next_word: string;
i: byte;
currLine: integer;
ER :TStrings;

begin
ER:=TStringList.Create;
ER.LoadFromFile('voc.txt');
For currLine := 0 To Pred(memo1.Lines.Count) Do Begin
s := memo1.Lines.Strings[currLine];
i := 1; next_word := '';
while i <= length(s) do begin
if upcase(s[i]) in ['A'..'Z'] then begin
next_word := next_word + s[i]; inc(i)
end
else begin
if next_word <> '' then replace_word(next_word);
Memo2.Lines.Add(s[i]);
next_word := ''; inc(i);
end;
end;

if next_word <> '' then replace_word(next_word);
end; er.free end;
Н
забыл добавить, что показывает при это на вот эту строку:

if next_word_rus='' then next_word_rus:=next_word;
hiv
Переменную ER :TStrings; нужно объявить как public в объекте TForm1, для того чтобы можно было к ней обращаться из разных процедур и функций твоей формы. А у тебя она объявлена дважды в разных процедурах - это тогда две разные переменные. Одну из них ты создал и выделил под нее память, а другую нет - но при этом от нее чего-то хочешь получить - вот тебе и ошибка! :yes:
А вообще-то ради двух строчек кода городить дополнительную процедуру (replace_word) не имеет смысла.
Н
Спасибо, теперь ошибки не выдает :D rolleyes.gif

Но перевод выводит как то непонятно: каждое слово и знак препинания в новой строке:

Англ текст
Цитата
Hello, world!


Перевод
Цитата
привет
,

мир
!



Может это я вывод в мемо не правельно сделал?
hiv
У тебя в коде:
Memo2.Lines.Add(s[i]);
эта процедура как раз и добавляет новую строку с содержимым s[i]
Тебе нужно вначале перевести всю строку, а только потом записывать ее в Memo2.
ЗЫ: Только писать нужно Memo2.Lines.Add(s); т.к. s[i] - это всего-то i-тый символ в строке.
Н
Вот делал вывод в мемо так:

 
procedure TForm1.Button1Click(Sender: TObject);

var
s, next_word, next_word_rus, t: string;
i: byte;
currLine: integer;

begin
t:='';
ER:=TStringList.Create;
ER.LoadFromFile('voc.txt');
For currLine := 0 To Pred(memo1.Lines.Count) Do Begin
s := memo1.Lines.Strings[currLine];
i := 1; next_word := '';
while i <= length(s) do begin
if upcase(s[i]) in ['A'..'Z'] then begin
next_word := next_word + s[i]; inc(i)
end
else begin
if next_word <> ''then next_word_rus:=ER.Values[next_word];
if next_word_rus='' then next_word_rus:=next_word;

t:= t + next_word_rus;

t:= t + s[i];

next_word := ''; inc(i);
end;
end;

Memo2.Lines.Append(t);

end; er.free end;



но выводится какая то чуш:
Цитата
    Hello, world!!!   



перевод
Цитата
    привет,привет мир!мир!мир! 



Как еще можно сделать вывод в мемо?
volvo
У меня вот так работает:
function TForm1.replace_word (var ER: tstrings; next_word: string): string;
var next_word_rus: string;
begin
next_word_rus:=ER.Values[next_word];
if next_word_rus='' then next_word_rus:=next_word;
result := next_word_rus;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
s, next_word, t: string;
i: byte;
currLine: integer;
ER :TStrings;

begin
t := '';
ER:=TStringList.Create;
ER.LoadFromFile('voc.txt');
For currLine := 0 To Pred(memo1.Lines.Count) Do Begin
s := memo1.Lines.Strings[currLine];
i := 1; next_word := '';
while i <= length(s) do begin
if upcase(s[i]) in ['A'..'Z'] then begin
next_word := next_word + s[i]; inc(i)
end
else begin
if next_word <> '' then t := t + replace_word(ER, next_word);
t := t + s[i];
next_word := ''; inc(i);
end;
end;

if next_word <> '' then t := t + replace_word(ER, next_word);
memo2.Lines.Add(t);
end;
er.free
end;
hiv
Цитата
но выводится какая то чуш:

Как запрограммировал - так и выводит! Вот так надо:
procedure TForm1.Button1Click(Sender: TObject);
var
s, next_word, next_word_rus, t: string;
i: byte;
currLine: integer;
begin
Memo2.Lines.Clear;
ER:=TStringList.Create;
ER.LoadFromFile('voc.txt');
for currLine := 0 to Pred(memo1.Lines.Count) do
begin
s := memo1.Lines.Strings[currLine];
t:=''; i := 1; next_word := '';
while i <= length(s) do
begin
while (i <= length(s)) and (upcase(s[i]) in ['A'..'Z']) do
begin
next_word := next_word + s[i];
inc(i);
end;
if next_word<>'' then
begin
next_word_rus:=ER.Values[next_word];
if next_word_rus='' then next_word_rus:=next_word;
t:= t + next_word_rus;
next_word := '';
end;
if i <= length(s) then t:= t + s[i];
inc(i);
end;
Memo2.Lines.Add(t);
end;
ER.Free;
end;
Н
Как же я сам то не додумался ..... :D

hiv, volvo Огромное спасибо.... Очень выручили.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.