Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Служба Рассылок Subscribe.Ru
Ежедневная рассылка сайта Мастера DELPHI

DELPHI.mastak.ru

Выпуск от 23.10.01 09:04

Поздравляем москвичей с первым снегом!
А тем, кто любит тепло, не отчаивайтесь! Скоро Новый Год, а там и до и лета рукой подать! :)
Лучшее из нашего FAQ   |x|
Как перевести RTF в HTML?
Здесь процедура, которую я использую для конвертации содержимого RichEdit в код SGML. Она не создает полноценный HTML-файл, но Вы можете расширить функциональность, указал, какие RTF-коды Вы желаете конвертировать в какие-либо HTML-тэги.

function rtf2sgml (text : string) : string;
{Funktion for att konvertera en RTF-rad till SGML-text.}
var
temptext : string;
start : integer;
begin
text := stringreplaceall (text,'&','##amp;');
text := stringreplaceall (text,'##amp','&');
text := stringreplaceall (text,'\'+chr(39)+'e5','a');
text := stringreplaceall (text,'\'+chr(39)+'c5','A');
text := stringreplaceall (text,'\'+chr(39)+'e4','a');
text := stringreplaceall (text,'\'+chr(39)+'c4','A');
text := stringreplaceall (text,'\'+chr(39)+'f6','o');
text := stringreplaceall (text,'\'+chr(39)+'d6','O');
text := stringreplaceall (text,'\'+chr(39)+'e9','e');
text := stringreplaceall (text,'\'+chr(39)+'c9','E! ');
text := stringreplaceall (text,'\'+chr(39)+'e1','a');
text := stringreplaceall (text,'\'+chr(39)+'c1','A');
text := stringreplaceall (text,'\'+chr(39)+'e0','a');
text := stringreplaceall (text,'\'+chr(39)+'c0','A');
text := stringreplaceall (text,'\'+chr(39)+'f2','o');
text := stringreplaceall (text,'\'+chr(39)+'d2','O');
text := stringreplaceall (text,'\'+chr(39)+'fc','u');
text := stringreplaceall (text,'\'+chr(39)+'dc','U');
text := stringreplaceall (text,'\'+chr(39)+'a3','?');
text := stringreplaceall (text,'\}','#]#');
text := stringreplaceall (text,'\{','#[#');
text := stringreplaceall (text,'{\rtf1\ansi\deff0\deftab720','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\fonttbl',''); {Skall alltid tas bort}
text := stringreplaceall (text,'{\f0\fnil MS Sans Serif;}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\f1\fnil\fcharset2 Symbol;}','');{Skall alltid tas bort}
text := stringreplaceall ! (text,'{\f2\fswiss\fprq2 System;}}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\colortbl\red0\green0\blue0;}','');{Skall alltid tas bort}
{I version 2.01 av Delphi finns inte \cf0 med i RTF-rutan. Tog darfor bort
det efter \fs16 och la istallet en egen tvatt av \cf0.}
//temptext := hamtastreng (text,'{\rtf1','\deflang');
//text := stringreplace (text,temptext,''); {Hamta och radera allt fran start till deflang}
text := stringreplaceall (text,'\cf0','');
temptext := hamtastreng (text,'\deflang','\pard');{Plocka fran deflang till pard for att fa }
text := stringreplace (text,temptext,'');{oavsett vilken lang det ar. Norska o svenska ar olika}
{Har skall vi plocka bort fs och flera olika siffror beroende pa vilka alternativ vi godkanner.}
//text := stringreplaceall (text,'\fs16','');{8 punkter}
//text := stringreplaceall (text,'\fs20','');{10 punkter}
{Nu stadar vi istallet bort alla tvasif! friga fontsize.}
while pos ('\fs',text) >0 do
begin
application.processmessages;
start := pos ('\fs',text);
Delete(text,start,5);
end;
text := stringreplaceall (text,'\pard\plain\f0 ','<P>');
text := stringreplaceall (text,'\par \plain\f0\b\ul ','</P><MELLIS>');
text := stringreplaceall (text,'\plain\f0\b\ul ','</P><MELLIS>');
text := stringreplaceall (text,'\plain\f0','</MELLIS>');
text := stringreplaceall (text,'\par }','</P>');
text := stringreplaceall (text,'\par ','</P><P>');
text := stringreplaceall (text,'#]#','}');
text := stringreplaceall (text,'#[#','{');
text := stringreplaceall (text,'\\','\');
result := text;
end;

//This is cut directly from the middle of a fairly long save routine that calls the above function.
//I know I could use streams instead of going through a separate fil! e but I have not had the time to change this

utfilnamn := mditted.exepath+stringreplace(stringreplace(extractfilename(pathname),'.TTT',''),'.ttt','') + 'ut.RTF';
brodtext.lines.savetofile (utfilnamn);
temptext := '';
assignfile(tempF,utfilnamn);
reset (tempF);
try
while not eof(tempF) do
begin
readln (tempF,temptext2);
temptext2 := stringreplaceall (temptext2,'\'+chr(39)+'b6','');
temptext2 := rtf2sgml (temptext2);
if temptext2 <>'' then temptext := temptext+temptext2;
application.processmessages;
end;
finally
closefile (tempF);
end;
deletefile (utfilnamn);
! temptext := stringreplaceall (temptext,'</MELLIS> ','</MELLIS>');
temptext := stringreplaceall (temptext,'</P> ','</P>');
temptext := stringreplaceall (temptext,'</P>'+chr(0),'</P>');
temptext := stringreplaceall (temptext,'</MELLIS></P>','</MELLIS>');
temptext := stringreplaceall (temptext,'<P></P>','');
temptext := stringreplaceall (temptext,'</P><P></MELLIS>','</MELLIS><P>');
temptext := stringreplaceall (temptext,'</MELLIS>','<#MELLIS><P>');
temptext := stringreplaceall (temptext,'<#MELLIS>','</MELLIS>');
temptext := stringreplaceall (temptext,'<P><P>','<P>');
temptext := stringreplaceall (temptext,'<P> ','<P>');
temptext := stringreplaceall (temptext,'<P&g! t;-','<P>_');
temptext := stringreplaceall (temptext,'<P>_','<CITAT>_');
while pos('<CITAT>_',temptext)>0 do
begin
application.processmessages;
temptext2 := hamtastreng (temptext,'<CITAT>_','</P>');
temptext := stringreplace (temptext,temptext2+'</P>',temptext2+'</CITAT>');
temptext := stringreplace (temptext,'<CITAT>_','<CITAT>-');
end;
writeln (F,'<BRODTEXT>'+temptext+'</BRODTEXT>');

Author: johan@lindgren.pp.se

»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
У нас большой выбор статей   |x|
Защита программ и данных с использованием электронных ключей. Часть 1 Введение.
Данный обзор не претендует на правдоподобность так как я (по мнению некоторых) совершенно не разбираюсь в этой теме. Это всего лишь жалкая попытка рассказать то, что я знаю сам.
Как же я пришел к выводу об необходимости использования электронных ключей???
Другие сайты о DELPHI   |x|
CyberHead Research
Программирование игр на Delphi. Подборка маиериалов по 3Ж-программированию на DirectX, OpenGL.
Опрос населения :)
К какой возрастной категории Вы принадлежите ?
»»» меньше 16
»»» от 17 до 20
»»» от 21 до 23
»»» от 24 до 26
»»» от 27 до 30
»»» от 30 до 35
»»» от 35 до 40
»»» от 40 до 44
»»» больше 45
Журнал "Мастера DELPHI"  |x|
Давно витающая в воздухе нашего сайта идея создания журнала, посвященного всеми нами любимой среде разработки Delphi, похоже, обретает зримую форму. Несомненно, ваше мнение о необходимости такого журнала, содержании рубрик и темах отдельных статей поможет сделать журнал более полезным и интересным. Высказать свое мнение, проголосовать или же подписаться вы можете на сайте. Без вашего участия, нам будет трудно сделать правильный журнал!
Для души

Хокку дня
Котенок пытается лакать
Сплошное молоко
Первого в жизни снега.

Афоризмы
И ностальгия уже не та, что была раньше (Симона Синьоре)

Фраза дня
Жизнь как телеграмма, - короткая и с ошибками.

И на закуску коротенький анекдот
- Доктор, у меня голова кружится...
- Я вижу.

Фотоприколы.
Начните день с хорошего настроения!
http://delphi.mastak.ru/cgi-bin/prikol.pl?id=9133


На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (delphi@mastak.com)

Добро пожаловать на сайт -= Мастера DELPHI =- 


http://subscribe.ru/
E-mail: ask@subscribe.ru
Отписаться
Убрать рекламу
Рейтингуется SpyLog

В избранное