| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Ошибка преобразования RTF в PlainText через TRichEdit [D7]
sniknik © (2009-04-09 13:11:00)Делается преобразование текста в RTF из данных базы куда они попали нормальным редактированием (ошибок нет) в компоненте TDBRichEdit каким образом - набором/копированием из буфера не знаю, я имею дело уже только с последствиями.
А последствия такие, после некоторых вариантов данных (фактически одного ;) компонент "виснет" не работают внесение в него нового текста, копирование из него и т.д., после сбоя он все время отдает один и тот же текст...
Вот эмулятор, с выделенным сбойным текстом ->
На форму положить TRichEdit и TCheckBox в онклик чекбокса код -procedure TForm1.CheckBox1Click(Sender: TObject);
var
Stream: TStringStream;
begin
Stream:= TStringStream.Create(
(*'{\rtf1\ansi\ansicpg1251\deff0\deflang1049{\fonttbl{\f0\fnil\fcharset204 MS Sans Serif;}{\f1\fmodern\fcharset204{\*\fname Courier New;}Courier New CYR;}}'+
'\viewkind4\uc1\pard\f0\fs16'+
'\par \''c2\''78\''78\''78\''78\''78:'+
'\par \protect\f1\fs20\''ca\''ee\''ed\''f2\''e0\''ea\''f2 \''ef\''f0\''e5\''e4\''f1\''f2\''e0\''e2\''e8\''f2\''e5\''eb\''ff \''c2\''78\''78\''78\''78\''78 \'''+
'e2 \''d7\''e5\''eb\''ff\''e1\''e8\''ed\''f1\''ea\''e5 0-000-000-00-00 \''cd\''78\''78\''78\''78\''78\''78\''78\''78 \''cf\''e0\''e2\''e5\''eb\protect0'+
'\par \f0\fs16'+
'\par }'*)
'{\rtf1\ansi\ansicpg1251\deff0\deflang1049{\fonttbl{\f0\fnil\fcharset204 MS Sans Serif;}}'+
'\viewkind4\uc1\pard\f0\fs16\''d1\''e5\''f0\''e3\''e5\''e9 000-00-00 \''e4\''ee\''e1. 000 \''ed\''e5 \''f0\''e0\''e1\''ee\''f2\''e0\''fe\''f2 \''f1\''f7\'''+
'e5\''f2\''f7\''e8\''ea\''e8 \''ef\''ee\''f1\''e5\''f2\''e8\''f2\''e5\''eb\''e5\''e9.'+
'\par \''e3\''e0\''f0\''e0\''ed\''f2\''e8\''ff'+
'\par }'
);
try
RichEdit1.PlainText:= not CheckBox1.Checked;
RichEdit1.Lines.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
Сразу будет рабочий, посмотреть как должно быть, после комментируете одно раскомментируете другое и готов вариант как не работает... (если работает одинаково значит у вас не D7... ;))
Вопрос, что с этим делать? Есть вариант гарантированного преобразования и так чтобы не висло? (компонент без TRichEdit?)
Виснет не код дельфи, виснет объект винды, при трассировке я доходил до посылки сообщения (Perform) с новым текстом, и он был действительно новый, но после, чтение получает старый...
Ну, а виндовый ВордПад, с ним нормально справляется, возможно это потому что у них 3й ричьэдит, а в дельфе первый, а текст как то получилось туда попал от третьего... х.з.
В принципе обошел тем, что вместо очистки текста в компоненте пересоздаю его... НО, заметил странную вещь, после десятка таких глючных текстов подряд на тестах (по идее в реальности не бывает такого, этот то один раз за все пару лет встретился) у меня отключается VPN(!!!???) и начинаются другие странности в системе (например комп не выключился кнопкой из винды, что давно уже нонсенс).
В общем решил "это ЖЖЖЖЖ не спроста!", и надо чтото делать... вопрос что? (лучшим вариантом наверное был бы готовый парсер-преобразователь, но не знаю такого)
Что посоветуете?
sniknik (2009-04-09 18:48:00) [1]> Это простенький парсер
Уже вижу, с пробелами мудрит, лишних вставляет, даже на простых RTF-ах. Но, все не с 0 делать (тем более у меня почему то было впечатление, что там что-то невероятно сложное... тома документации по rtf-у голову запудрили... а ты можно сказать сломал этот психологический барьер ;)).
Rouse_ (2009-04-09 18:35:00) [2]Это простенький парсер, то-же для какого-то примитива делался, на более сложных документах нужно чуть доправить, добавив более четкое определение ненужных (отсекаемых) символов...
sniknik (2009-04-09 18:31:00) [3]> Тебе обычный Plain чтоль нужен?
Именно.
Х.м. а выглядит все проще чем ожидал... но работает. Спасибо.
Проверю на по всем значениям базы, и можно будет использовать.
Rouse_ (2009-04-09 18:24:00) [4]Тебе обычный Plain чтоль нужен? Попробуй вот это (из каких-то старых запасников вытащил):
function RTF2PlainText(const Value: string): string;
var
ACursor, I, Len, Tmp, SkipCount: Integer;
Wait: Boolean;
procedure CheckSize(const Offset: Integer);
begin
if I + Offset > Len then
Abort;
end;
begin
Len := Length(Value);
Result := StringOfChar(#0, Len);
if Copy(Value, 1, 5) <> '{\rtf' then Exit;
I := 2;
ACursor := 1;
SkipCount := 0;
Wait := False;
try
while I < Len do
begin
case Value[I] of
'{':
begin
Inc(SkipCount);
Inc(I);
end;
'}':
begin
Dec(SkipCount);
Inc(I);
end;
'\':
begin
if SkipCount > 0 then
begin
Inc(I);
Continue;
end;
if Wait then
Wait := False;
CheckSize(1);
if Value[I + 1] = '''' then
begin
CheckSize(3);
Result[ACursor] :=
Char(StrToInt('$' + Value[I + 2] + Value[I + 3]));
Inc(ACursor);
Inc(I, 4);
Continue;
end;
CheckSize(4);
if (Copy(Value, I, 4) = '\par') and (Value[I + 4] in ['\', ' ']) then
begin
Result[ACursor] := #13;
Result[ACursor + 1] := #10;
Inc(ACursor, 2);
Inc(I, 4);
Continue;
end;
if (Copy(Value, I, 4) = '\tab') and (Value[I + 4] in ['\', ' ']) then
begin
Result[ACursor] := #9;
Inc(ACursor);
Inc(I, 4);
Continue;
end;
Wait := True;
Inc(I);
end;
' ':
begin
Result[ACursor] := Value[I];
Inc(ACursor);
Inc(I);
Wait := False;
end
else
if not Wait and (SkipCount = 0) then
begin
Result[ACursor] := Value[I];
Inc(ACursor);
end;
Inc(I);
end;
end;
except
on E: EAbort do ;
// nothing
on E: Exception do
raise;
end;
Result := PChar(Result);
end;
sniknik (2009-04-09 18:21:00) [5]> Что-то вроде:
Чтото вроде нифига не конвертит...
Пробую
SetRichText(
RichEdit1.Handle,
'тут все те же примеры RTF '
);
Memo1.Text:= GetRichText(RichEdit1.Handle);
Как был так и остался в кодах ртф-а, в плайн не преобразовывается... заменял флаги (TxtEx.flags) при внесении/чтении на SF_TEXT/SF_RTF по аналогии как при обычной работе, тоже самое (ну разве что если ставить SF_RTF при чтениии то вообще ничего не отдает).
Да и вообще, это же вроде как код присваивания юникода...? Чем он поможет?
> что riched32.dll (riched20.dll ?) не ахти
Пока искал, такого начитался... не "ахти" это ОЧЕНЬ, ОЧЕНЬ мягко и даже ласково... :)
(зато теперь понимаю почему борланд не спешил с переходом с 1-й на 3-ю версию)
KilkennyCat © (09.04.09 17:13) [3]
> и предлагал ее замену...
Замену придется "таскать" с собой, и без гарантий что что-то не поставят и не перетрут (офис по моему ставит свои).
Проще тогда поднапрячься и самому парсер написать, ведь для преобразования в плайн текст не обязательно полное соответствие формату (там у них по доке очень много), все непонятное будет откидываться.
KilkennyCat (2009-04-09 17:13:00) [6]
> Что посоветуете?
Я лет 5 назад наткнулся на статью о глючности дллки. Не вспомню уже, в чем суть, но просто факт - товарищ признавал, что riched32.dll (riched20.dll ?) не ахти, и предлагал ее замену... с другой стороны, прошло много времени...
Romkin (2009-04-09 15:49:00) [7]Что-то вроде:
type
SETTEXTEX = packed record
flags: DWORD; { flags (see the ST_XXX defines }
codepage: UINT; { code page for translation (CP_ACP for default,
1200 for Unicode }
end;
TSetTextEx = SETTEXTEX;
GETTEXTEX = packed record
cb: DWORD; { count of bytes in the string }
flags: DWORD; { flags (see the GT_XXX defines }
codepage: UINT;
lpDefaultChar: LPCSTR; { replacement for unmappable chars }
lpUsedDefChar: PBOOL; { pointer to flag set when def char used }
end;
TGetTextEx = GETTEXTEX;
GETTEXTLENGTHEX = packed record
flags: DWORD; { flags (see the GTL_XXX defines }
codepage:UINT;
end;
TGetTextLengthEx = GETTEXTLENGTHEX;
function GetTextLength(Handle: HWND): integer;
var
txtLen: TGetTextLengthEx;
begin
ZeroMemory(@TxtLen, SizeOf(TxtLen));
txtLen.codepage := 1200;
txtLen.flags := GTL_USECRLF + GTL_PRECISE + GTL_NUMCHARS;
Result := SendMessage(Handle, EM_GETTEXTLENGTHEX, Longint(@TxtLen), 0);
end;
function GetRichText(Handle: HWND): WideString;
var
TxtEx: TGetTextEx;
begin
SetLength(Result, GetTextLength(Handle));
if Result = '' then
exit;
ZeroMemory(@TxtEx, SizeOf(TxtEx));
TxtEx.cb := (Length(Result) + 1) * SizeOf(WideChar);
TxtEx.flags := GT_USECRLF;
TxtEx.codepage := 1200;
TxtEx.lpDefaultChar := nil;
TxtEx.lpUsedDefChar := nil;
SendMessage(Handle, EM_GETTEXTEX, Longint(@TxtEx),
Longint(PWideChar(Result)));
end;
function GetRichSelection(Handle: HWND): WideString;
var
TxtEx: TGetTextEx;
begin
SetLength(Result, GetSelLength(Handle));
if Result = '' then
exit;
ZeroMemory(@TxtEx, SizeOf(TxtEx));
TxtEx.cb := (Length(Result) + 1) * SizeOf(WideChar);
TxtEx.flags := GT_USECRLF + GT_SELECTION;
TxtEx.codepage := 1200;
TxtEx.lpDefaultChar := nil;
TxtEx.lpUsedDefChar := nil;
SendMessage(Handle, EM_GETTEXTEX, Longint(@TxtEx),
Longint(PWideChar(Result)));
end;
procedure SetRichText(Handle: HWND; s: WideString);
var
TxtEx: TSetTextEx;
begin
if s = '' then
s := #0;
ZeroMemory(@TxtEx, SizeOf(TxtEx));
TxtEx.flags := ST_DEFAULT;
TxtEx.codepage := 1200;
SendMessage(Handle, EM_SETTEXTEX, Longint(@TxtEx), Longint(PWideChar(s)));
end;
sniknik (2009-04-09 13:28:00) [8]p.s. если препарсить и самому убирать секции \protect, \protect0 то RTF становиться перевариваемым... но, как всегда, а это только от них зависит?
| |
