Rich Text Format

Storing a rich edit text in a db

From: Mike Bardill <rrmike@minster.york.ac.uk>

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.

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;

Word Count in Richedit

From: ksudar@erols.com

>Does anyone know how to carry out a word count for the delphi richedit
>component ??

Someone posted this a few weeks ago.. I tried it and it seems to work.

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;

RichEdit Error with Delphi 2.01 and NT 4

James V. Bacus <bacuslab@mcs.net>

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?

Yes, I have a solution and a fix...

To fix this problem requires a minor change to the VCL unit ComCtrls.pas.

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...

{
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;

RTF to printer problem

Carl Steinhilber [carl_steinhilber@eriver.com]

> 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.

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:

  
shellExecute(mainForm.handle,
               nil,
               'write.exe',
               'myfile.rtf /p',
               nil,
               SW_HIDE);

(I found that using the WRITE.EXE stub is a bit more universal because WORDPAD.EXE isn't always on the path.)

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.

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.

translate RTF to HTML

From: johan@lindgren.pp.se

>   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?

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.

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;

//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>');

Please email me and tell me if you liked this page.

This page has been created with