• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 298
  • Last Modified:

Converting Color of fonts

hi,

I'm using a richedit with a black background and white font. The problem is that when opening a rtf document, usually the fonts are black, so I need to convert them. Now I do it using richedit and looking at each character and converting it to white. But it is slow.
Does anyone know how to make a fast routine, maybe using a memorystream or something.
the routine will be something like this then,
selecting a file with Opendialog load it into a memorystream, do the converting, dump it in Richedit.
But the formatting must be left intact. I'm giving a lot of points. So I would appreciate working code.
Thanks
0
hellfire052497
Asked:
hellfire052497
  • 8
  • 5
  • 5
1 Solution
 
Hagen040798Commented:
hi,

have you set the Color from the DefAttributes ?
When black the Defaultcolor from the RTF-File is, the DefAttributes from the RichEdit set then the Fontcolor.

Hagen.
0
 
Hagen040798Commented:
Hi,

A other Way is:
In the RTF-File is storred a Colortable:

{\colortbl ;\red255\green0\blue255;\red0\green0\blue0;\red0\green0\blue255;}

Now, you read the first lines from the File or write a TConverter for the RichEdit and change all Entrys with xxx0 (red0, green0 ...) to xxx255.

{\colortbl ;\red255\green0\blue255;\red255\green255\blue255;\red0\green0\blue255;}

This is fast. Hagen.

0
 
rene100Commented:
i've tested this with the follwing code:

procedure TForm1.Button3Click(Sender: TObject);
var
l: integer;
begin
richedit1.setfocus;
l:=SendMessage(richedit1.handle,WM_GetTextLength,0,0);
richedit1.selstart:=0;
richedit1.sellength:=l;
richedit1.SelAttributes.Color:=clgreen; //or other color
end;

and it's quite fast. (p200, 600kb-file)
how big is your file?

regards
rene
0
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
hellfire052497Author Commented:
hi,

A slight misunderstanding, Only the Black font has to be converted to white, all the other colors must be left intact.. So that is why I do it character by character. There must be a way to make it fast. Example appreciated

Thanks
0
 
Hagen040798Commented:
Hi

Yes, you must not reformat the text when your change the Colortable from the RTF-File. This Table is storred at the beginning in the File. see above.
0
 
rene100Commented:
her's a function that should do the job:

procedure TForm1.Button1Click(Sender: TObject);
var
FileData: TMemoryStream;
DataString: string;
index: integer;
SubStringList,EndData: tstrings;
Pos1,Pos2: integer;
SubString1,SubString2,ClrTable1,ClrTable2: string;
begin
SubStringList:=TStringlist.Create;
EndData:=TStringlist.Create;
FileData:=TMemoryStream.Create;
if OpenDialog1.Execute<>true then
   //free all
   exit;
FileData.LoadFromFile(OpenDialog1.Filename);
FileData.Position:=0;
SetLength(DataString,FileData.size);
FileData.read(DataString[1],FileData.size);
Pos2:=Pos('{\colortbl',DataString);
SubString1:=Copy(DataString,Pos2,FileData.Size-Pos2);
Pos1:=Pos('}',SubString1);
SubString2:=Copy(SubString1,11,Pos1-12);
GetSubStrings(SubString2,SubStringList,0,';');
ClrTable1:='';
for Index:=0 to SubStringList.count-1 do
    begin
    if SubStringList[Index]='\red0\green0\blue0' then
       SubStringList[index]:='\red255\green255\blue255';
    ClrTable1:=ClrTable1+SubStringList[Index]+';';
    end;
ClrTable2:='{\colortbl'+ClrTable1+'}';
Delete(DataString,Pos2,Pos1);
Insert(ClrTable2,DataString,Pos2);
FileData.Position:=0;
EndData.Add(DataString); //got problems with direct writing from
EndData.SaveToStream(FileData);//a string to a stream,so i use a
FileData.Position:=0;          // new string list
Richedit1.Lines.LoadFromStream(FileData);
FileData.free;
SubStringList.free;
EndData.free;
end;

function GetSubStrings(SourceString: string;var StringList: TStrings;RequestedElement: integer;Separator: string): integer;
var
Index,LastHitIndex,EndIndex: integer;
ElementNumber: word;
TempString: string;
begin
LastHitIndex:=0;
EndIndex:=0;
Separator:=LowerCase(Separator);
SourceString:=LowerCase(SourceString);
ElementNumber:=0;
for Index:=1 to length(SourceString) do
    begin
    EndIndex:=Index;
    if (Copy(SourceString,Index,1)=Separator) and (Index>0) then
       begin
       TempString:=Copy(SourceString,LastHitIndex+1,Index-LastHitIndex-1);
       if (Index<>1)  then
          begin
          ElementNumber:=ElementNumber+1;
          if RequestedElement=0 then
             StringList.Add(TempString)
          else
             begin
             if RequestedElement=ElementNumber then
                begin
                StringList.Add(TempString);
                Result:=StringList.count;
                exit;
                end;
             end;
          end;
       LastHitIndex:=Index;
       end;
    end;
if LastHitIndex<>EndIndex then
   begin
   TempString:=(Copy(SourceString,LastHitIndex+1,length(SourceString)-LastHitIndex));
   StringList.Add(TempString)
   end;
Result:=StringList.count;
//There's a lot of overhead in this function, but I use this as
//a general function and not only for this purpose, sorry
end;

regards
rene
0
 
hellfire052497Author Commented:
hi,

It does work, and fast too, But on this it doesn't work

http://paul.balpol.tudelft.nl/delphi/converters/

Could you check it out! I would hate not to be able to use this Converter, it uses the Wordpad and Word convertors, So you can import .doc and other formats in Richedit. The color conversion works, When I use it character by character, it does it good. But with this code you supplied it doesn't. Perhaps a small thing has to be changed.

Check it out it is worth it. And free too.
Thanks
Marc
0
 
rene100Commented:
are you sure that your link is right?
can't connecting to it.

rene
0
 
rene100Commented:
ok, now it should work:

procedure TForm1.Button1Click(Sender: TObject);
var
FileData: TMemoryStream;
DataString: string;
index: integer;
SubStringList,EndData: tstrings;
Pos1,Pos2: integer;
SubString1,SubString2,ClrTable1,ClrTable2,EmptyTable: string;
begin
SubStringList:=TStringlist.Create;
EndData:=TStringlist.Create;
FileData:=TMemoryStream.Create;
if OpenDialog1.Execute<>true then
   //free all
   exit;
FileData.LoadFromFile(OpenDialog1.Filename);
FileData.Position:=0;
SetLength(DataString,FileData.size);
FileData.read(DataString[1],FileData.size);
Pos2:=Pos('{\colortbl',DataString);
SubString1:=Copy(DataString,Pos2,FileData.Size-Pos2);
Pos1:=Pos('}',SubString1);
SubString2:=Copy(SubString1,11,Pos1-12);
SubString2:=RemoveLeftSpace(SubString2);
if Copy(SubString2,1,1)=';' then
   EmptyTable:=';'
else
   EmptyTable:='';
GetSubStrings(SubString2,SubStringList,0,';');
ClrTable1:='';
for Index:=0 to SubStringList.count-1 do
    begin
    if SubStringList[Index]='\red0\green0\blue0' then
       SubStringList[index]:='\red255\green255\blue255';
    ClrTable1:=ClrTable1+SubStringList[Index]+';';
    end;
ClrTable2:='{\colortbl'+EmptyTable+ClrTable1+'}';
Delete(DataString,Pos2,Pos1);
Insert(ClrTable2,DataString,Pos2);
FileData.Position:=0;
EndData.Add(DataString);
EndData.SaveToStream(FileData);
FileData.Position:=0;
Richedit1.Lines.LoadFromStream(FileData);
FileData.free;
SubStringList.free;
EndData.free;
end;

function RemoveLeftSpace(TargetString: string): string;
var
Index: integer;
begin
for Index:=1 to length(TargetString) do
    begin
    if Copy(TargetString,1,1)=' ' then
       TargetString:=Copy(TargetString,2,Length(TargetString)-1);
    end;
Result:=TargetString;
end;

(GetSubStrings doesn't change)

regards
rene
0
 
Hagen040798Commented:
Hi rene100

the link is ok.

Hagen.
0
 
hellfire052497Author Commented:
hi,

Almost there, with the convertor, some text is ignored. so here and there there are still black areas. If you need some .doc's for example I have them ready to send them.

Thanks again

0
 
rene100Commented:
ok, please send me the docs to

rene.mooser@netsurfer.ch

rene
0
 
Hagen040798Commented:
Hi

I test it with the \colortbl and i found:

1. not all RTF-Files use the \colortbl
2. when the RTF-File use a \colortbl, then can the entry \red0\green0\blue0 not exists.

so, you must put allways a \colortbl and add a new entry with \red255\greed255\blue255, when the \colortbl exists convert all entrys with \red0\green0\blue0 and then put the new colortbl in the File. After the colortbl put '\cfxxx' {Fontcolor}, xxx is the Index from the new Color-Entry in the Table an define the Fontcolor from the follow Text.

Hagen
0
 
rene100Commented:
hi

there's possibly a other reasons for the problem:
in many programs (i.e. wordpad), you can choose the color
'automatic', and that seems to be black in the most cases. the
real problem is, that with this 'color', there's no \cfxxx entry, just nothing. so you have to check every line and add an
\cfxxx entry if needed.
i will check that as soon as marc has send me the docs.

regards

rene
0
 
rene100Commented:
hi marc

first, thanks for the files.i've checked it and can say this:
in testfile1, i think there's simply a bug in wordpad, because it
saves the colortable-index after the text, and so it is ingnored
when reading and the color is set to 'automatic', means black (see comment above)

in pstrip.doc, the problem is also with the automatic-color (means no colortable-index)
i will try to write a function that solve this, but this function
will probably be slow, because it has to check every line.

regards
rene
0
 
hellfire052497Author Commented:
hi,

Thanks for looking into it. I dont mind a slower routine, As I said I used character by character first, that was slow, anything else is bound to be faster. And as a last resource I can always make it an option, so you can activate the routine manually instead at opening a document.

Take care
0
 
hellfire052497Author Commented:
Sorry Hagen, but Rene did all the work on this.
0
 
rene100Commented:
Hi all

the solution is quite large, so if anyone is interessed in
the solution, please mail to
rene.mooser@netsufer.ch

kind regards

rene
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 8
  • 5
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now