Ошибка преобразования RTF в PlainText через TRichEdit

← →
sniknik © (2009-04-09 13:11) [0]

Делается преобразование текста в 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 13:28) [1]

p.s. если препарсить и самому убирать секции \protect, \protect0 то RTF становиться перевариваемым... но, как всегда, а это только от них зависит?

← →
Romkin © (2009-04-09 15:49) [2]

Что-то вроде:
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;

← →
KilkennyCat © (2009-04-09 17:13) [3]

> Что посоветуете?

Я лет 5 назад наткнулся на статью о глючности дллки. Не вспомню уже, в чем суть, но просто факт - товарищ признавал, что riched32.dll (riched20.dll ?) не ахти, и предлагал ее замену... с другой стороны, прошло много времени...

← →
sniknik © (2009-04-09 18:21) [4]

> Что-то вроде:
Чтото вроде нифига не конвертит...

Пробую
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]
> и предлагал ее замену...
Замену придется "таскать" с собой, и без гарантий что что-то не поставят и не перетрут (офис по моему ставит свои).
Проще тогда поднапрячься и самому парсер написать, ведь для преобразования в плайн текст не обязательно полное соответствие формату (там у них по доке очень много), все непонятное будет откидываться.

← →
Rouse_ © (2009-04-09 18:24) [5]

Тебе обычный 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;

> Тебе обычный Plain чтоль нужен?
Именно.
Х.м. а выглядит все проще чем ожидал... но работает. Спасибо.
Проверю на по всем значениям базы, и можно будет использовать.

Это простенький парсер, то-же для какого-то примитива делался, на более сложных документах нужно чуть доправить, добавив более четкое определение ненужных (отсекаемых) символов...

> Это простенький парсер
Уже вижу, с пробелами мудрит, лишних вставляет, даже на простых RTF-ах. Но, все не с 0 делать (тем более у меня почему то было впечатление, что там что-то невероятно сложное... тома документации по rtf-у голову запудрили... а ты можно сказать сломал этот психологический барьер ;)).

Ошибка преобразования RTF в PlainText через TRichEdit Найти похожие ветки