Solved

Converting Color of fonts

Posted on 1998-09-16
18
241 Views
Last Modified: 2013-12-02
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
Comment
Question by:hellfire052497
  • 8
  • 5
  • 5
18 Comments
 
LVL 2

Expert Comment

by:Hagen040798
Comment Utility
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
 
LVL 2

Expert Comment

by:Hagen040798
Comment Utility
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
 
LVL 2

Expert Comment

by:rene100
Comment Utility
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
 

Author Comment

by:hellfire052497
Comment Utility
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
 
LVL 2

Expert Comment

by:Hagen040798
Comment Utility
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
 
LVL 2

Expert Comment

by:rene100
Comment Utility
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
 

Author Comment

by:hellfire052497
Comment Utility
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
 
LVL 2

Expert Comment

by:rene100
Comment Utility
are you sure that your link is right?
can't connecting to it.

rene
0
 
LVL 2

Expert Comment

by:rene100
Comment Utility
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
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 2

Expert Comment

by:Hagen040798
Comment Utility
Hi rene100

the link is ok.

Hagen.
0
 

Author Comment

by:hellfire052497
Comment Utility
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
 
LVL 2

Expert Comment

by:rene100
Comment Utility
ok, please send me the docs to

rene.mooser@netsurfer.ch

rene
0
 
LVL 2

Expert Comment

by:Hagen040798
Comment Utility
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
 
LVL 2

Expert Comment

by:rene100
Comment Utility
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
 
LVL 2

Expert Comment

by:rene100
Comment Utility
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
 

Author Comment

by:hellfire052497
Comment Utility
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
 

Author Comment

by:hellfire052497
Comment Utility
Sorry Hagen, but Rene did all the work on this.
0
 
LVL 2

Accepted Solution

by:
rene100 earned 260 total points
Comment Utility
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

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now