|
Вопрос # 4 876/ вопрос открыт / |
|
Здравствуйте, камрады! С наступающим всех!
Пишу парсер BB-code, наткнулся на баг TRichEdit - не работает FindText для кириллицы - как быть?
вот код https://www.delphi-int.ru/code/73873e5e
с английским текстом отлично работает, а вот с русским нет(
 |
Вопрос задал: mirt.steelwater (статус: Посетитель)
Вопрос отправлен: 1 января 2011, 00:32
Состояние вопроса: открыт, ответов: 0.
|
Мини-форум вопроса
Всего сообщений: 26; последнее сообщение — 11 января 2011, 08:13; участников в обсуждении: 4.
Страницы: [1] [2] [Следующая »]
|
Вадим К (статус: Академик), 1 января 2011, 22:38 [#1]:
Очень сложный и беспощадный код. Для того, что бы написать такой парсер, не нужен компонент TRichEdit, и поиск в нем тем более.
Кажется мне, что поиск не работает немного по другой причине. Не потому что русский текст.
Если просто загрузить в него текст и попробовать искать русский текст, ищет?
p.s. делфи старше 2007?
p.p.s. есть гораздо красивее способ сделать вышеприведённый парсер. Работать будет быстро и красиво, и ещё и ошибки вычислять
Галочка "подтверждения прочтения" - вселенское зло.
|
|
min@y™ (статус: Доктор наук), 2 января 2011, 17:17 [#2]:
Не вижу связи между тремя вещами: парсером, TRichEdit и поиском текста. Ну-ка, уважаемый, колись давай, зачем тебе такой коктейль?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
eclipse (статус: Посетитель), 2 января 2011, 20:30 [#3]:
Да полюбому для кликовых сайтов! Как-то давно такой фигнёй занимался тока там не поиском текста надо пользоваться а Ole объектами.
|
|
|
mirt.steelwater (статус: Посетитель), 3 января 2011, 00:55 [#4]:
ок, по-порядку.
Этот код делает следующее:
Здесь описан класс потока, который в компоненте TRichEdit заменяет текст между тэгами [B]test[/B] на жирное написание test, аналогично с курсивом [I]test[/I], подчеркнутым [U]test[/U] и перечеркнутым текстом [S]test[/S]. Для того, чтобы не приводить к тормозам в основном потоке программы, как я уже говорил это реализовано в виде отдельного потока. Зачем нужен TRichEdit - потому что я знаю только такой стандартный компонент, от которого можно отталкиваться для отображения разных стилей шрифта, шрифта разного цвета и вставки изображений (предполагается сделать аналогичную замену тэгов [COLOR:#RGB]test[/COLOR] на написание слова соответствующим цветом, тэг [SIZE:size]test[/SIZE] заменять на написание слова соответствующим размером шрифта, тэг [IMG:file_name][/IMG] заменять на соответствующее изображение).
Как я уже говорил, все отлично работает с английским текстом, а с русским - не работает.
Если кто еще не понял - вот картинки:
до парсинга:
http://s41.radikal.ru/i092/1101/50/a277ed5c5d26.jpg
после:
http://s003.radikal.ru/i203/1101/43/fd50b9534052.jpg
среда Delphi2006, за основу взят TRichEdit еще и потому, что используется его аналог в AlpaSkins
проблема обсуждалась ранее на других форумах - проблема в работе метода TRichEdit.FindText с русскими буквами, однако решение нигде не описано. Пробовал отсылать сообщение напрямую - эффект тот же, Pos использовать нельзя из-за невидимых rtf-символов. Я бы с удовольствием воспользовался чем-то готовым с открытым исходным кодом, но такого я не нашел.
OLE-объекты не предлагать - это вполне тривиальная задача, которую многие дельфийцы избегают достойно решить, и я бы сам справился, но столкнулся с багом от мелкософта.
Если вы дочитали до этого места и все еще не понятно - попробуйте отдельно скопировать функцию ApplyFontStyleTag в новый проект и вызвать ее с такими параметрами:
ApplyFontStyleTag(RichEdit1,'[B]test[/B]',fsBold);
и так:
ApplyFontStyleTag(RichEdit1,'[B]тест[/B]',fsBold);
естественно, у вас в RichEdit1 должно встречаться [B]test[/B] и [B]тест[/B].
еще картинки
http://s51.radikal.ru/i132/1101/b4/e8b779ba6c5d.jpg
http://s005.radikal.ru/i210/1101/d6/63c28f7b0bc8.jpg
p.s. не знаю что такое "кликовые сайты", но они явно не имеют к этому никакого отношения. это поддержка BB-кодов для локального шифрованного форума.
Ⓐ свобода сопротивление солидарность
|
|
|
min@y™ (статус: Доктор наук), 3 января 2011, 11:35 [#5]:
Всё равно не понимаю, зачем хранить текст до парсинга в том же RichEdit? Почему не в памяти?
Цитата (mirt.steelwater):
Зачем нужен TRichEdit - потому что я знаю только такой стандартный компонент, от которого можно отталкиваться для отображения разных стилей шрифта
Если нужно только отображение, то не лучше ли воспользоваться, например, TWebBrowser или THtmlLite?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
mirt.steelwater (статус: Посетитель), 3 января 2011, 17:50 [#6]:
текст до парсинга можно, конечно и в памяти хранить, тогда проблемы с поиском в принципе отпадают, но в таком случае появляется очень много других неприятных проблем - если ничего не придумаю, то прийду к этому варианту, конечно.
TWebBrowser со всеми багами от мелкомягких идет в топку.
THTMLLite интереснее - расскажи что он умеет, если пользовался.
Ⓐ свобода сопротивление солидарность
|
|
|
mirt.steelwater (статус: Посетитель), 3 января 2011, 20:22 [#7]:
вообщем установил я этот THTMLLite и THTMLViewer для потомков оставляю ссылку, откуда качал: http://pbear.com/ (насколько я понял - это официальный сайт) Что я могу сказать - THTMLLite - чересчур лайт, нет бэкграунда и т.п.; THTMLViewer - мощнее, но громоздко, я бы сказал - неоправданно громоздко. Не хватает важных моментов: "загрузка в реальном времени", т.е. "дозагрузка" строк - как я это представляю - было бы св-во Lines: TStringList, в которое добавил строчку - она если попадает в область видимости - отобразилась - нет - не отобразилась, ничего не перерисовалась, просто добавилась. Сложно интегрируем с AlphaSkins - с ходу не представляю как туда прикрутить красивый скролл - с наскоку не вышло( вообщем-то вот так. Кто что может порекомендовать?
Ⓐ свобода сопротивление солидарность
|
|
|
min@y™ (статус: Доктор наук), 3 января 2011, 20:30 [#8]:
Цитата (mirt.steelwater):
TWebBrowser со всеми багами от мелкомягких идет в топку.
Поверь старому Джузеппе - глюков и багов в TRichEdit настолько дохрена, что просто пипец. Им пользуются только дилетанты.
Цитата (mirt.steelwater):
THTMLLite интереснее - расскажи что он умеет, если пользовался.
Гугл и офсайт.
Цитата (mirt.steelwater):
THTMLLite - чересчур лайт, нет бэкграунда и т.п
That's wrong, плохо смотрел.
ЗЫ: дальше не читал, смотри демо, там оно должно быть. Там на его основе целый браузер написан.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
min@y™ (статус: Доктор наук), 3 января 2011, 20:47 [#10]:
Ссылки не смотрел
Лучше - неверно есть, но я не знаю, у меня другие цели. Глянь торри.нет.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
mirt.steelwater (статус: Посетитель), 3 января 2011, 21:27 [#11]:
товарищи эксперты, очень нужно сделать хорошую поддержку BB-code без всяких там html-ей желательно, очень нужна ваша помощь
Ⓐ свобода сопротивление солидарность
|
|
|
min@y™ (статус: Доктор наук), 3 января 2011, 21:48 [#12]:
Цитата (mirt.steelwater):
очень нужно сделать хорошую поддержку BB-code без всяких там html-ей желательно, очень нужна ваша помощь
Это понятно, но чего тебе от нас-то надо? Хорошую поддежку BB-code в ричэдите ты не сделаешь, это 100%.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Вадим К (статус: Академик), 3 января 2011, 23:35 [#13]:
В библиотеке jvcl есть набор компонентов, которые умеют парсить примитивный html. К примеру есть memo или listbox, которому можно задать разноцветный текст.
По поводу BB кодов. Так ли они уж необходимы? может оставить обычный TRichEdit и дать пользователю форматировать текст? А то пользователь хитрый, напишет что то вида [b]q[i]w[/b][/i] и будет сердиться Хотя это исправимо. Я бы писал не заменой как в приведенном примере, а полноценным нормальным парсером. Благое дело, что такой парсер пишется за пару часов на коленке. И работать будет быстро, и ошибки вычислять.
По поводу скинов. Плохо это. очень плохо. мало того, что страшно, так ещё тормозит, и для половины пользователей неюзабельно. Почему? а потому что попробуйте на своей машине выставить шрифт побольше и расползется дизайн. Или человек поставил уже свою тему, которую, к примеру купил, и хочет что бы все контролы выглядели как он хочет. А Вы с своим "мегаинтерфесом". Или пример с жизни, отламывал я у одной такой проги скин. Пользователь программы - дальтоник и неразличал часть цветов. А в самой программе так были они подобраны, что текст различался с большим трудом...
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
mirt.steelwater (статус: Посетитель), 4 января 2011, 20:30 [#14]:
оставить форматирование в TRichEdit просто нельзя - это ж сколько мусора в бд запишется..
что значит полноценный нормальный парсер - вот с этого места поподробнее.
а jvcl я посмотрю, спасибо
Ⓐ свобода сопротивление солидарность
|
|
|
mirt.steelwater (статус: Посетитель), 5 января 2011, 20:57 [#16]:
Спасибо за ссылки, вообщем-то тут вроде реализация того же, что я хотел сделать, но без многопоточности и без извлечения текста из TRichEdit, думаю это мне поможет. Как перегнать BB в HTML я знаю. Еще раз спасибо
Ⓐ свобода сопротивление солидарность
|
|
|
Вадим К (статус: Академик), 6 января 2011, 00:09 [#17]:
только не вздумайте переганять вначале в html, а потом в rtf!
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
mirt.steelwater (статус: Посетитель), 7 января 2011, 00:03 [#18]:
вот что вышло
type
TEditStreamCallBack = function (dwCookie: LongInt;
pbBuff: PByte;
cb: LongInt;
var pcb: LongInt) : DWORD; stdcall;
TEditStreamData = packed record
dwCookie : LongInt;
dwError : LongInt;
pfnCallback : TEditStreamCallBack;
end;
function EditStreamInCallback (dwCookie: Longint;
pbBuff: PByte;
cb: Longint;
var pcb: Longint) : DWORD; stdcall;
var
Stream : TStream;
dataAvail : LongInt;
begin
Result := UINT (E_FAIL);
try
Stream := TStream (dwCookie);
if Assigned (Stream) then
with Stream do
begin
dataAvail := Size - Position;
Result := 0;
if ( dataAvail <= cb ) then
begin
pcb := Read (pbBuff^,dataAvail);
if ( pcb <> dataAvail ) then
Result := UINT (E_FAIL);
end
else
begin
pcb := Read (pbBuff^,cb);
if ( pcb <> cb ) then
Result := UINT (E_FAIL);
end;
end;
except
Result := UINT (E_FAIL);
end;
end;
procedure PutRTFSelection (anObject: TRichEdit; aSourceStream: TStream);
var
Data : TEditStreamData;
begin
try
if not ( Assigned (anObject) ) then
raise Exception.CreateFmt ('Объект класса ''%s'' не инициализирован!',
[anObject.ClassName]);
with Data do
begin
dwCookie := LongInt (aSourceStream);
dwError := 0;
pfnCallback := EditStreamInCallBack;
end;
anObject.Perform ( EM_STREAMIN, SF_RTF or SFF_SELECTION, LongInt (@Data) );
except on E: Exception do
raise Exception.CreateFmt ('Ошибка инъекции данных!'#13#10'%s',
[E.Message]);
end;
end;
function StrReplace (const Source, Search, Replace: String) : String;
var
Buf1 : String;
Buf2 : String;
Buffer : String;
I : Integer;
begin
Result := Source;
Buf1 := '';
Buf2 := Source;
Buffer := Source;
while ( Pos (Search, Buf2) > 0 ) do
begin
Buf2 := Copy ( Buf2, Pos (Search, Buf2), ( Length (Buf2) - Pos (Search, Buf2) ) + 1 );
buf1 := Copy ( Buffer, 1, Length (Buffer) - Length (Buf2) ) + Replace;
Delete ( Buf2, Pos (Search, Buf2), Length (Search) );
Buffer := Buf1 + Buf2;
end;
Result := Buffer;
end;
procedure InsertBBCode (anObject: TRichEdit; const aBBCode: String);
var
Stream : TStringStream;
s : String;
colors : String;
begin
s := aBBCode;
s := StrReplace (s,'[B]','\b');
s := StrReplace (s,'[/B]','\b0');
s := StrReplace (s,'[I]','\i');
s := StrReplace (s,'[/I]','\i0');
s := StrReplace (s,'[U]','\ul');
s := StrReplace (s,'[/U]','\ulnone');
s := StrReplace (s,'[S]','\strike');
s := StrReplace (s,'[/S]','\strike0');
s := StrReplace (s,#13#10,'\par ');
colors := '';
Stream := TStringStream.Create ( Format ('{\rtf1{\colortbl ;%s}%s}',[colors,s]) );
if Assigned (Stream) then
try
PutRTFSelection (anObject,Stream);
finally
FreeAndNil (Stream);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
InsertBBCode (Richedit1,'[B]привет[/B]'#13#10'[S]привет[/S]'#13#10);
InsertBBCode (Richedit1,'[U]привет[/U]'#13#10);
end;
с цветами еще немного нужно пошевелить мозгами, но вроде получается
Ⓐ свобода сопротивление солидарность
|
|
|
Вадим К (статус: Академик), 7 января 2011, 00:17 [#19]:
У кода есть только один недостаток - он не проверяет корректность входного потока.
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
mirt.steelwater (статус: Посетитель), 9 января 2011, 19:32 [#20]:
сделал поддержку цвета:
type
TEditStreamCallBack = function (dwCookie: LongInt;
pbBuff: PByte;
cb: LongInt;
var pcb: LongInt) : DWORD; stdcall;
TEditStreamData = packed record
dwCookie : LongInt;
dwError : LongInt;
pfnCallback : TEditStreamCallBack;
end;
function EditStreamInCallback (dwCookie: Longint;
pbBuff: PByte;
cb: Longint;
var pcb: Longint) : DWORD; stdcall;
var
Stream : TStream;
dataAvail : LongInt;
begin
Result := UINT (E_FAIL);
try
Stream := TStream (dwCookie);
if Assigned (Stream) then
with Stream do
begin
dataAvail := Size - Position;
Result := 0;
if ( dataAvail <= cb ) then
begin
pcb := Read (pbBuff^,dataAvail);
if ( pcb <> dataAvail ) then
Result := UINT (E_FAIL);
end
else
begin
pcb := Read (pbBuff^,cb);
if ( pcb <> cb ) then
Result := UINT (E_FAIL);
end;
end;
except
Result := UINT (E_FAIL);
end;
end;
procedure PutRTFSelection (anObject: TRichEdit; aSourceStream: TStream);
var
Data : TEditStreamData;
begin
try
if not ( Assigned (anObject) ) then
raise Exception.CreateFmt ('Объект класса ''%s'' не инициализирован!',
[anObject.ClassName]);
with Data do
begin
dwCookie := LongInt (aSourceStream);
dwError := 0;
pfnCallback := EditStreamInCallBack;
end;
anObject.Perform ( EM_STREAMIN, SF_RTF or SFF_SELECTION, LongInt (@Data) );
except on E: Exception do
raise Exception.CreateFmt ('Ошибка инъекции данных!'#13#10'%s',
[E.Message]);
end;
end;
function StrReplace (const Source, Search, Replace: String) : String;
var
Buf1 : String;
Buf2 : String;
Buffer : String;
begin
Result := Source;
Buf1 := '';
Buf2 := Source;
Buffer := Source;
while ( Pos (Search, Buf2) > 0 ) do
begin
Buf2 := Copy ( Buf2, Pos (Search, Buf2), ( Length (Buf2) - Pos (Search, Buf2) ) + 1 );
Buf1 := Copy ( Buffer, 1, Length (Buffer) - Length (Buf2) ) + Replace;
Delete ( Buf2, Pos (Search, Buf2), Length (Search) );
Buffer := Buf1 + Buf2;
end;
Result := Buffer;
end;
function GetColors (var aBBCode: String) : String;
var
Buf1 : String;
Buf2 : String;
Buf3 : String;
Buffer : String;
color : String;
R : Byte;
G : Byte;
B : Byte;
Pallete : WORD;
begin
Result := '';
Buf1 := '';
Buf2 := aBBCode;
Buf3 := '';
Buffer := aBBCode;
R := 0;
G := 0;
B := 0;
Pallete := 0;
while ( Pos ('[COLOR=#',Buf2) > 0 ) do
begin
Buf2 := Copy ( Buf2, Pos ('[COLOR=#', Buf2), ( Length (Buf2) - Pos ('[COLOR=#', Buf2) ) + 1 );
Buf1 := Copy ( Buffer, 1, Length (Buffer) - Length (Buf2) );
color := Copy ( Buf2, Pos ('[COLOR=#', Buf2) + Length ('[COLOR=#'), Length ('RRGGBB') );
R := StrToInt ( Format ('$%s',[Copy (color,1,2)]) );
G := StrToInt ( Format ('$%s',[Copy (color,3,2)]) );
B := StrToInt ( Format ('$%s',[Copy (color,5,2)]) );
Result := Format ('%s\red%d\green%d\blue%d;',[Result,R,G,B]);
Inc (Pallete);
Delete ( Buf2, Pos ('[COLOR=#', Buf2), Length ('[COLOR=#RRGGBB]') );
Buf3 := Copy ( Buf2, 1, ( Pos ('[/COLOR]', Buf2) - 1 ) );
Buf2 := Copy ( Buf2, Pos ('[/COLOR]', Buf2) + Length ('[/COLOR]'), ( Length (Buf2) - Pos ('[/COLOR]', Buf2) ) +
1 );
Buffer := Format ('%s\cf%d %s\cf%d %s',[Buf1,Pallete,Buf3,Pallete,Buf2]);
end;
aBBCode := Buffer;
end;
procedure InsertBBCode (anObject: TRichEdit; const aBBCode: String);
var
Stream : TStringStream;
s : String;
colors : String;
begin
s := aBBCode;
s := StrReplace (s,'[B]','\b');
s := StrReplace (s,'[/B]','\b0');
s := StrReplace (s,'[I]','\i');
s := StrReplace (s,'[/I]','\i0');
s := StrReplace (s,'[U]','\ul');
s := StrReplace (s,'[/U]','\ulnone');
s := StrReplace (s,'[S]','\strike');
s := StrReplace (s,'[/S]','\strike0');
s := StrReplace (s,#13#10,'\par ');
colors := GetColors (s);
Stream := TStringStream.Create ( Format ('{\rtf1{\colortbl ;%s}%s}',[colors,s]) );
if Assigned (Stream) then
try
PutRTFSelection (anObject,Stream);
finally
FreeAndNil (Stream);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
InsertBBCode (Richedit1,'[B]привет[/B]'#13#10'[S]привет[/S]'#13#10);
InsertBBCode (Richedit1,'[U]привет[/U]'#13#10);
InsertBBCode
(Richedit1,'[COLOR=#FF0000]привет[/COLOR]'#13#10'[COLOR=#00FF00]привет[/COLOR]'#13#10'[COLOR=#0000FF]привет[/COLOR]'#13#10);
InsertBBCode (Richedit1,'[COLOR=#FFFF00][B][U]прив[COLOR=#FF0000]е[/COLOR]т[/U][/B][/COLOR]');
end;
картинка:
http://img196.imageshack.us/img196/5408/64408727.png
как видите, столкнулся спроблемой вложенных тэгов - как бы ее правильно решить?
Ⓐ свобода сопротивление солидарность
|
Страницы: [1] [2] [Следующая »]
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
