well..
you need to make two steps...
first:...
change in your project to send HTML email...
in your smtpclient change "text/plain" to => "text/html"
second...
you need to translate your RichEdit (rtf format) to html format...
use this component to make this component...
==============rtf2html.pas=================
{$D-,L-,Y-}
unit rtf2html;
(*
----------------------------------------------------------------------------
----
Revision history:
Nb. Date: Author What was done.
003 ? ? ?
002 21-aug-1997 TSE Minor (very minor) cleanup before release
001 20-aug-1997 TSE Unit created - RtfToHTML function
designed and written.
Author list:
TSE Troels Skovmand Eriksen TSErik...@{*word*104}dude.com
TSEri...@post8.tele.dk
? ? ?
Supported features:
rev. 001 Indents, Bullets, Left-, Centered & Rightjustified text,
Text styles (bold, italics and underline),
Fonts (face, size, color).
rev. 002 - do -
rev. 3 ?
----------------------------------------------------------------------------
----
This unit and all procedures and functions herein is released as
freeware. Any components or units created using this unit or
portions hereoff must be released as freeware (This does not
cover applications - they may be shareware/commercial as needed).
Part of the function RtfToHTML may be covered by some obscure
Microsoft copyright since it reads the RTF format - check it out
yourself, if you do something worthwhile.
Please let this preface stay if you publish a changed/updated
version of this unit and write all changes the "Revision history"
section above. Who-Dun-it information should be inserted in the
"Author list" and the "Supported features" section should be updated.
This makes it easier to pass the blame :-)
I'm finished with this unit for now - but please email a copy of
any changes you make to me - Troels S Eriksen.
----------------------------------------------------------------------------
----
The following should be fixed - if anybody want to do it?
* Should be rewritten into a conversion class - could be tricky, since
it seems like a stream only contains 4 Kb at a time ...
* Code should be cleaned up - this below is not that fast ...
* The indents (\li###) should be translated to <BLOCKQUOTE> or
just a <UL> with no <LI> elements.
* The{*word*154} paragraphs should be translated to definitionlists ( the
<DL COMPACT> <DT> term <DD> definition </DL> structure )
* Tabs (\tab) should be fixed somehow ( heck, I DO want
a <TAB> code ! )
* Embedded objects / pictures should be converted to .gif's
- I know it's possible
* Some nice way to handle links ( the way .rtf-sources for
helpfiles do ? )
* A even more nice way of handling tables - could fix the
indent / tab-problems as well
----------------------------------------------------------------------------
----
The idea and logic behind this weirdo function :
Well, the idea was to write a pascal RTF-2-HTML converter which
doesn't just do some "search and replace" - but actually converts
the dammed stuff.
Since there's a difference between HTML and RTF in the
code-sequencing, I decided to try storing all paragraph and
textformatting information in two records (PARFMT and
TXTFMT) and only write the contents of these to the output
"stream" when needed.
This first attempt is successfull - not highly, but it'll convert
the contents of a TRichEdit control and most other .rtf documents
to HTML and keep the general layout.
Enjoy it
Troels S Eriksen, Denmark
----------------------------------------------------------------------------
----
*)
{$LONGSTRINGS ON}
interface
function RtfToHtml(const rtf:string):string;
implementation
uses
Classes, SysUtils;
function RtfToHtml(const rtf:string):string;
type
TState = record
FntTbl : boolean;
ColTbl : boolean;
FntLst,
ColLst : TStringList;
end;
TPARFMT = record
Alignment : TAlignment; { h?jre, venstre, centreret tekst }
Bullets : integer; { Skriv bulletliste <UL> = 1
Skriv element <LI> = 2
Skriv element{*word*232} </LI> = 3
Skriv liste{*word*232} </UL> = 4 }
Written : boolean; { true hvis skrevet til streng }
end;
TTXTFMT = record
ChangeF : boolean;
DefFont : integer;
Font : integer;
Fontsize : integer;
Color : integer;
Bold : integer;
Italics : integer;
Underline : integer;
Written : boolean;
end;
var
indx : integer; // index i rtf-streng
ParFmt : TParFmt;
TxtFmt : TTxtFmt;
State : TState;
Group : integer;
Col : string[10];
Fnt : string[63];
procedure WriteChar(c:Char);
var
S : string;
begin
s:='';
// First - get ready to write paragraph formatting
With PARFMT do if not Written then begin
// TextAttr's must be off before starting a new paragraph
{
add "uses forms" to the implementation or interface statement,
then call application.processmessages here - this would allow
you to work the application interface will saving a large file.
With TXTFMT do begin
if bold>1 then begin
s:=s+'</B>';
if bold=3 then bold:=0;
end;
if italics>1 then begin
s:=s+'</I>';
if italics=3 then Italics:=0;
end;
if underline>1 then begin
s:=s+'</U>';
if underline=3 then Underline:=0;
end;
end;
{ Write either bulletlist or left-, center, rightjustified paragraph
(doing it this way makes bulletlists leftjustified no matter
what) }
case Bullets of
0 : case Alignment of
taLeftJustify : s:=s+#13#10'<P>';
taRightJustify: s:=s+#13#10'<P ALIGN=RIGHT>';
taCenter : s:=s+#13#10'<P ALIGN=CENTER>';
end;
1 : s:=s+#13#10'<UL>';
2 : s:=s+#13#10'<LI>';
3 : s:=s+'</LI>';
4 : begin
s:=s+#13#10'</UL>';
Bullets:=0;
end;
5 : begin
s:=s+'<BR>'#13#10#160#32#160#32#160;
Bullets:=0;
end;
end;
// If any textattr's was on before - they are re-enabled
With TXTFMT do begin
If Bold=2 then s:=s+'<B>';
If Italics=2 then s:=s+'<I>';
If Underline=2 then s:=s+'<U>';
end;
Written:=TRUE;
end; { PARFMT }
// Second - Write any textattr's
With TXTFMT do if not written then begin
// If font has changed - write it
If changeF then begin
s:=s+'<FONT FACE="'+state.fntlst.strings[Font]+
'" COLOR="'+state.collst.strings[Color]+
'" SIZE="'+IntToStr(FontSize)+'">';
ChangeF:=FALSE;
end;
// If any textattr's should be written - do it
case Bold of
1 : begin
s:=s+'<B>';
bold:=2;
end;
3 : begin
s:=s+'</B>';
Bold:=0;
end;
end;
case Italics of
1 : begin
s:=s+'<I>';
Italics:=2;
end;
3 : begin
s:=s+'</I>';
Italics:=0;
end;
end;
case Underline of
1 : begin
s:=s+'<U>';
Underline:=2;
end;
3 : begin
s:=s+'</U>';
Underline:=0;
end;
end;
Written:=TRUE;
end;
// At last - write the character it self
case c of
#0 : result:=result+s; // Writes pending codes only
#9 : result:=result+s+#9; // Writes tab char
'>' : result:=result+s+'>'; // Writes "greater than"
'<' : result:=result+s+'<'; // Writes "less than"
else result:=result+s+c; // Writes a character
end;
end; { WriteChar }
function Resolve(c:char):integer;
{ Convert char to integer value - used to decode \'## to an ansi-value }
begin
case byte(c) of
48..57 : Result:=byte(c)-48;
65..70 : Result:=byte(c)-55;
else Result:=0;
end;
end; { resolve }
function CollectCode(i:integer):integer;
var
Value,
Keyword : string;
a : integer;
begin
KeyWord:='';
// First - check if keyword is any "special" keyword or is a normal one
...
case rtf[i+1] of
'*' : begin // Ignorre to end of group
a:=group;
repeat
case rtf[i] of
'{' : inc(group);
'}' : dec(group);
end;
inc(i);
until (group+1)=a;
result:=i-1;
end;
#39 : begin // Decode hex value
WriteChar(char(resolve(upcase(rtf[i+2]))*16+resolve(upcase(rtf[i+3]))));
Inc(i,3);
result:=i;
end;
'\','{','}' : begin // Return special character
WriteChar(rtf[i+1]);
inc(i);
result:=i;
end;
else begin
// First - get keyword ...
repeat
keyword:=keyword+rtf[i];
inc(i);
until (rtf[i] in ['{','\','}',' ',';','0'..'9']);
// Second - get any value following ...
Value :='';
While (rtf[i] in ['a'..'z','0'..'9']) do begin
value:=value+rtf[i];
inc(i);
end;
if rtf[i]=' ' then inc(i);
while (rtf[i] in ['{','}',';']) do inc(i);
result:=i-1;
{ Check which keyword and what to do - NB: Test shows that using
IF THEN ELSE .. is approx. 10% more efficient than calling EXIT }
if keyword='\par' then with PARFMT do begin
// New paragraph or bullet item
if
...
read more »
