📄 rtf.htm
字号:
<!-- This document was created with HomeSite v2.5 -->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<TITLE>UDDF - Rich Text Format</TITLE>
<META NAME="Description" CONTENT="Rich Text Format section of the Delphi Developers FAQ" >
<META NAME="Keywords" CONTENT="" >
</HEAD>
<BODY bgcolor="#FFFFFF">
<CENTER>
<IMG SRC="../images/uddf.jpg"> </CENTER>
<HR SIZE="6" COLOR="LIME">
<CENTER><FONT SIZE="7" FACE="Arial Black" COLOR="RED">Rich Text Format</FONT></CENTER>
<H1><A NAME="rtf0">Storing a rich edit text in a db</A></H1>
<I><P>From: Mike Bardill <rrmike@minster.york.ac.uk></P>
</I><P>Saving a TRichEdit to a file and storing the file is a perfectly good way of saving the data to the table,
but the same can be achieved without an intermediate file by using a TBlobStream.
The example below is for reading a TRichEdit from a table, but a similar approach 'in reverse' with a bmWrite will save into the table. </P>
<P><HR></P>
<PRE>procedure ReadRichEditFromTable(Table : TTable; var RichEdit : TRichEdit);
var
BlobStream : TBlobStream;
begin
try
BlobStream := TBlobStream.Create(Table.FieldByName('BODY') as TBlobField, bmRead);
if (not Table.FieldByName('BLOBFieldName').IsNull) then
begin
RichEdit.Lines.LoadFromStream (BlobStream);
end;
finally
BlobStream.Free;
end;
end;</PRE>
<P><HR></P>
<P><H1><A NAME="rtf1">Word Count in Richedit</P></A></H1>
<P><I>From: ksudar@erols.com</I></P>
<PRE>>Does anyone know how to carry out a word count for the delphi richedit
>component ??
</PRE>
Someone posted this a few weeks ago.. I tried it and it seems to work.<P>
<HR><PRE>function GetWord: boolean;
var s: string; {presume no word>255 chars}
c: char;
begin
result:= false;
s:= ' ';
while not eof(f) do
begin
read(f, c);
if not (c in ['a'..'z','A'..'Z'{,... etcetera}]) then break;
s:=s+c;
end;
result:= (s<>' ');
end;
procedure GetWordCount(TextFile: string);
begin
Count:= 0;
assignfile(f, TextFile);
reset(f);
while not eof(f) do if GetWord then inc(Count);
closefile(f);
end;
</PRE><HR>
<P><H1><A NAME="rtf2">RichEdit Error with Delphi 2.01 and NT 4</P></A></H1>
<P><I>James V. Bacus <bacuslab@mcs.net></I></P>
<PRE>
I have written a program that collects information that a user selects, by
a number of checkboxes and buttons, to a non visible RichEdit box. The
program was written under Windows 95 and works fine. But under NT 4.0 the
line ...
RichEdit1.Print('');
returns a Divide by Zero Error. The only way I have found round this is to
save the file and use Word to print the final file.
Does anyone have or know of any workrounds?
</PRE>
Yes, I have a solution and a fix...<P>
To fix this problem requires a minor change to the VCL unit ComCtrls.pas.<P>
I've tested this on many different systems running NT 4.0 and Win95, and all
seems to work well now. It's actually a very simple fix, and here it is...<P>
<HR><PRE>{
A compatibility problem exists with the original RichEdit.Print method
code and the release of NT 4.0. A EDivByZero exception is caused because
accessing the Printer.Handle property outside of a BeginDoc/EndDoc block
returns an Information Context (IC) handle under NT 4.0 instead of a
Device Context (DC) handle. The EM_FORMATRANGE attempts to use this IC
instead of a real printer DC, which causes the exception. If the Handle
property is accessed AFTER the BeginDoc, a true Device Context handle is
returned, and I have modified the code to handle this correctly. I have
left the original position of BeginDoc in the code but remarked it out to
indicate the difference. J.V.Bacus 11/12/96
}
procedure TCustomRichEdit.Print(const Caption: string);
var
Range: TFormatRange;
LastChar, MaxLen, LogX, LogY: Integer;
begin
FillChar(Range, SizeOf(TFormatRange), 0);
with Printer, Range do
begin
LogX := GetDeviceCaps(Handle, LOGPIXELSX);
LogY := GetDeviceCaps(Handle, LOGPIXELSY);
// The repositioned BeginDoc to now be compatible with
// both NT 4.0 and Win95
BeginDoc;
hdc := Handle;
hdcTarget := hdc;
if IsRectEmpty(PageRect) then
begin
rc.right := PageWidth * 1440 div LogX;
rc.bottom := PageHeight * 1440 div LogY;
end
else begin
rc.left := PageRect.Left * 1440 div LogX;
rc.top := PageRect.Top * 1440 div LogY;
rc.right := PageRect.Right * 1440 div LogX;
rc.bottom := PageRect.Bottom * 1440 div LogY;
end;
rcPage := rc;
Title := Caption;
// The original position of BeginDoc
{ BeginDoc; }
LastChar := 0;
MaxLen := GetTextLen;
chrg.cpMax := -1;
repeat
chrg.cpMin := LastChar;
LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
until (LastChar >= MaxLen) or (LastChar = -1);
EndDoc;
end;
SendMessage(Handle, EM_FORMATRANGE, 0, 0);
end;
</PRE><HR>
<P><H1><A NAME="rtf3">RTF to printer problem</P></A></H1>
<P><I>Carl Steinhilber [carl_steinhilber@eriver.com]</I></P>
<PRE>
> One of my colleagues needs to print an RTF file. The problem is that the
> RTF component that comes with D2 (and all the shareware/commercial
> components we've found) wants to load the entire file before starting to
> print. The file, prepared in advance, may be *very* large and may not fit
> in memory. Quick printing is essential and waiting for the file to load
> just isn't a good option.
</PRE>
One of the solutions I hit
upon that might work for you, particularly since you're
running under Win95, is shelling out to WordPad with an
undocumented feature:<p>
<HR><PRE>
shellExecute(mainForm.handle,
nil,
'write.exe',
'myfile.rtf /p',
nil,
SW_HIDE);
</PRE><HR>
(I found that using the WRITE.EXE stub is a bit more universal
because WORDPAD.EXE isn't always on the path.)<p>
The "/p" parameter is the undocumented feature. It will launch WordPad,
print the file, then close WordPad. And with SW_HIDE, the only thing
you see is the Printing status box.<p>
WordPad probably loads as much as it can into memory before
printing, but it should be able to handle any size file by
segmentation. And WordPad has a pretty small footprint, so it
loads and prints fairly quickly. It's also generally on every
Win95 system.<p>
<P><H1><A NAME="rtf4">translate RTF to HTML</P></A></H1>
<P><I>From: johan@lindgren.pp.se</I></P>
<PRE>
> lopezj@iluso.ci.uv.es (Agustin Lopez Bueno) writes:
> I need translate the contents of a RTF component to HTML
> with Delphi. Anybody knows how to do this?
</PRE>
This is a routine I use to convert the content of a RichEdit to SGML-code. It does not produce a complete HTML-file but you will
have to figure out which RTF-codes you should convert to which HTML-tags. <p>
<HR><PRE>function rtf2sgml (text : string) : string;
{Funktion för att konvertera en RTF-rad till SGML-text.}
var
temptext : string;
start : integer;
begin
text := stringreplaceall (text,'&','##amp;');
text := stringreplaceall (text,'##amp','&amp');
text := stringreplaceall (text,'\'+chr(39)+'e5','&aring;');
text := stringreplaceall (text,'\'+chr(39)+'c5','&Aring;');
text := stringreplaceall (text,'\'+chr(39)+'e4','&auml;');
text := stringreplaceall (text,'\'+chr(39)+'c4','&Auml;');
text := stringreplaceall (text,'\'+chr(39)+'f6','&ouml;');
text := stringreplaceall (text,'\'+chr(39)+'d6','&Ouml;');
text := stringreplaceall (text,'\'+chr(39)+'e9','&eacute;');
text := stringreplaceall (text,'\'+chr(39)+'c9','&Eacute;');
text := stringreplaceall (text,'\'+chr(39)+'e1','&aacute;');
text := stringreplaceall (text,'\'+chr(39)+'c1','&Aacute;');
text := stringreplaceall (text,'\'+chr(39)+'e0','&agrave;');
text := stringreplaceall (text,'\'+chr(39)+'c0','&Agrave;');
text := stringreplaceall (text,'\'+chr(39)+'f2','&ograve;');
text := stringreplaceall (text,'\'+chr(39)+'d2','&Ograve;');
text := stringreplaceall (text,'\'+chr(39)+'fc','&uuml;');
text := stringreplaceall (text,'\'+chr(39)+'dc','&Uuml;');
text := stringreplaceall (text,'\'+chr(39)+'a3','&#163;');
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 därför bort
det efter \fs16 och la istället en egen tvätt av \cf0.}
//temptext := hamtastreng (text,'{\rtf1','\deflang');
//text := stringreplace (text,temptext,''); {Hämta och radera allt från start till deflang}
text := stringreplaceall (text,'\cf0','');
temptext := hamtastreng (text,'\deflang','\pard');{Plocka från deflang till pard för att få }
text := stringreplace (text,temptext,'');{oavsett vilken lang det är. Norska o svenska är olika}
{Här skall vi plocka bort fs och flera olika siffror beroende på vilka alternativ vi godkänner.}
//text := stringreplaceall (text,'\fs16','');{8 punkter}
//text := stringreplaceall (text,'\fs20','');{10 punkter}
{Nu städar vi istället bort alla tvåsiffriga 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;
</PRE><HR>
<HR><PRE>//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 file 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>-','<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>');
</PRE><HR>
<HR SIZE="6" COLOR="LIME">
<FONT SIZE="2">
<a href="mailto:rdb@ktibv.nl">Please email me</a> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
<TD>This page has been created with </TD>
<TD> <A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>
</FONT>
</BODY>
</HTML>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -