Color Text

SetSelTextBuf should have a PChar as parameter
i think it would be better if you'd call SetSelTextBuf after changing the SelAttributes
i'm gonna try a little bit by myself.

regs,

Black Death.

no forget it that was a big pile of crap

Black Death.

hehe
ok, but what now ?

hi omsec,

its not perfect, but it works once in the first line

const
  KeyWord = 'Synax';
var
  Position : Word;
begin
  Position := Pos(KeyWord, RichEdit1.Lines[0]);
  if Position <> 0 then
  begin
    RichEdit1.SelStart := Position - 1;
    RichEdit1.SelLength := Length(KeyWord);
    RichEdit1.SelAttributes.Color := clBlue;
 
{ set the cursor to the end of line }

    RichEdit1.SelStart := length(RichEdit1.Lines[0]);
    RichEdit1.SelLength := 0;

{ set textcolor to black }

    RichEdit1.SelAttributes.Color := clBlack;
  end;
end;

meikl

Hello guys .here is what i got..

    procedure TForm1.RichEdit1Change(Sender: TObject);
    const
      KeyWord = 'Synax';
    var
      nPos : Integer;
      Len : byte; 0
    begin
      nPos := Pos(KeyWord, RichEdit1.Text);
      if Pos > 0 then begin  
          KeyWordL := Length(KeyWord);  
          RichEdit1.SelStart := nPos - 1;
          RichEdit1.SelLength := KeyWordL;
          RichEdit1.SelAttributes.Color := clBlue;
        end;
      RichEdit1.SelStart := Length(RichEdit1.Text);
      RichEdit1.SelAttributes.Color := clBlack;
    end;

Regards,
Viktor Ivanov

Viktor: Did you really try out ? it diesnt work correctly.

What I need is 'Syntax Checking' liek the Delphi IDE does. YOu know Keywords are in bold etc.

I need to write some pre-defined words in different colors. main color is black.

No I haven't tested it before....here it is and it works, but a flickers ...take a look at it and decide....

procedure TForm1.RichEdit1Change(Sender: TObject);
const
        KeyWord = 'Synax';
      var
         nPos : Integer;
        Len : byte;
    begin
           nPos := Pos(KeyWord, RichEdit1.Text);
           if nPos > 0 then begin
               Len := Length(KeyWord);
               RichEdit1.SelStart := nPos - 1;
               RichEdit1.SelLength := Len;
               RichEdit1.SelAttributes.Color := clBlue;
               RichEdit1.SelStart := Length(RichEdit1.Text);
                 RichEdit1.SelAttributes.Color := clBlack;
             end;
         end;

Regards,
Viktor Ivanov

Here is something else I used before for something...you could try this one too....

procedure UnderLine(RichEdit : TRichEdit; sWord : string);
var
  nPos, OldStart, Len : Integer;
begin
  nPos := Pos(sWord, RichEdit.Text);
  OldStart := RichEdit.SelStart;
  RichEdit.SetFocus;
  while nPos > 0 do begin
    RichEdit.SelStart := nPos - 1;
    RichEdit.SelLength := Length(sWord);
    RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsUnderline];
    RichEdit.SelLength := 0;
    RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsUnderline];
    Len := Pos(sWord, Copy(RichEdit.Text, (nPos-1) + Length(sWord), Length(RichEdit.Text)));
    if Len <> 0 then
        nPos := nPos + (Len+1)
    else
        break;
  end;
  RichEdit.SelStart := OldStart;
end;

Example Call: UnderLine(RichEdit1, 'Syntax');

Regards,
Viktor Ivanov

Heee heee, I have been trying this at work with a simple VB Scripting language that I composed...  

  tRichEdit is just not up to the job...even if you get it all working OK, it is dog slow, and can flicker and does lose the position that you are currently at...  

  The conclusion that I reached, is that what you basically have to do, is an ownerdraw edit box, where you can mark "dirty" areas (ie: areas that have been changed), and then recolour these dirty areas with the choice of colours that you have selected....  

  Obviously, you need a simple parser to pull out the type for each word (keyword, variablename, literal, etc), but the actual  code will end up being quite huge and horrible...  (you will have to catch almost _all_ of the messages sent to the window, etc)...

  I started to do this, and then realised just quite how much work it will entail (so it still remains on the "to-do" Post-it-Note side of my desk :)

  Sorry for this depressing messge, but I hope this can maybe point you in the correct direction...

  Tim Yates.

PS:  If you do stick with the RichEdit format, to help reduce the flicker, send the RichEdit a WM_SETREDRAW, false message (PostMessage( richedit1.handle, WM_SETREDRAW, 0, 0 ) ), and then set it to WM_SETREDRAW,true  (PostMessage( richedit1.handle, WM_SETREDRAW, 0, 0 ) ) after you have finished all of your colouring thigs...  I also had it only performing an update via a Timer object, so that it sped things up a bit...

Sorry, obviously, that second message should have been:

PostMessage( richedit1.handle, WM_SETREDRAW, 1, 0 )

Tim.

Oh yeah, it also seems to lock up if the test gets too big and complex (but that just might have been my shoddy code ;) )

const
      key='Syntex';
var
      npos:integer;
      len,totallen:integer;
   temptext:string;
begin
   npos:=pos(key,richedit1.text);
   if npos=0 then
   begin
         richedit1.selattributes.color:=clblack;
   end;
   temptext:=richedit1.text;
       len:=length(key);
   totallen:=length(richedit1.text);
   while npos>0 do
      begin
      richedit1.selstart:=totallen-length(temptext)+npos-1;
      richedit1.sellength:=len;
      temptext:=copy(temptext,npos+len,length(temptext)-npos-len+1);
      npos:=pos(key,temptext);
      richedit1.selattributes.color:=clblue;
      richedit1.selstart:=totallen;
      richedit1.selattributes.color:=clblack;
   end;
end;

why not use some existing syntax highlighting VCLs?

Such as Color Memo.(Freeware, but without source)

hi omsec

this code look like work better,

const
  KeyWord = 'Synax';

begin
  if copy(RichEdit1.text,RichEdit1.SelStart - length(keyword), length(keyword)) = Keyword then
  begin
    RichEdit1.SelStart := RichEdit1.SelStart - length(keyword) - 1;
    RichEdit1.SelLength := Length(KeyWord);
    RichEdit1.SelAttributes.Color := clBlue;
    RichEdit1.SelStart := RichEdit1.SelStart + length(keyword) + 1;
    RichEdit1.SelLength := 0;
    RichEdit1.SelAttributes.Color := clBlack;
  end;
end;

meikl

Is it me, or is everyone basically repeating the same answer?

*grin*

Tim

well, thank you guys for all this informations. Now I'm going to test all these code in my application. I also heard it could need another component, other than RichEdit. If there is a good one, that is RTF-Compatible, well why not ? :)

I didn't know it's that much of work and complicated, any way, i will increase points for a flicker-free, "real-time" solution.

:)

Well, I have tested all of the Procs posted and I think, actually for my Case, the second Procedure from kretzschmar works best...

i think kretzschmar deserved the points

because Delphi is not case sensitive you need to do the following,.....

if UpperCase(copy(RichEdit1.text,RichEdit1.SelStart - length(keyword),
     length(keyword))) = UpperCase(Keyword) then begin
.
.
REST OF CODE
.
.
end;

Regards,
Viktor Ivanov

hi.

i've got yet another (slightly different) solution. i've built it thursday night at home. then i had to go to berlin for the weekend and just arrived directly at work so i haven't got it with me. i'm making use of the findtext method of the RichEdit comp. but basically it's the same as kretschmar's. give him the points.

i'll post my code tomorrow if you're still interested.

cheers,

Black Death.

well, have you already written it anyway, and like i said, i would be interessted to see your code too :)

hi blackdeath, hi omsec,

my code works not in every situation. for example the user writes syax and insterts the n later this will not be detected by my routine. So I am also interrested for blackdeath code too.

meikl

i'm gonna test it with some borderline cases. cu tomorrow. bye,

Black Death.

i believe we have to check the entire RichEdit every time when some changes are made from line 0 to last. But i dunno how much this would slow down the program...

hi omsec,

the time to scan the whole entire of richedit.text depends how much text is in it.

i have a little bit modified my procedure. Now I scan backward and forward at the Cursorposition with length of Keyword, and can handle the situation of my last comment. This procedure takes allways the same time.
But is it perfect?

procedure TForm1.RichEdit1Change(Sender: TObject);
const
  KeyWord = 'Synax';
var
  TmpS : String;
  oldSelStart : integer;
begin
  TmpS := copy(RichEdit1.text,RichEdit1.SelStart - length(keyword), (length(keyword) * 2));

  if Pos(Keyword,TmpS) > 0 then
  begin
    OldSelStart := RichEdit1.SelStart;
    RichEdit1.SelStart := RichEdit1.SelStart - length(keyword) + Pos(Keyword,TmpS)- 2;
    RichEdit1.SelLength := Length(KeyWord);
    RichEdit1.SelAttributes.Color := clBlue;
    RichEdit1.SelStart := OldSelStart;
    RichEdit1.SelLength := 0;
    RichEdit1.SelAttributes.Color := clBlack;
  end;
end;


meikl

hi omsec,

the best theoretical solution is

(make whole text black)
color each keyword in blue (findtext)

this all timertriggered

blackdeath i'm awaiting your code

meikl

hi, meikl:
please take note of my last comment.
;-)

cu,

Black Death.

ach - a little tip:

the reason why i think that my code is able to detect the "rising" of the keyword by typing a missing letter within a word which then becomes the keyword is:

the selection length in my code is not of length(keyword) but from SelStart-length(keyword) (except when difference between SelStart and this length would be negative - then of course SelStart would be zero) to the end of the test in the richedit and i use findtext, which relates to the selected text and does not find the 1st occurence within the whole text or a tmpstr you first have to copy. so i think it should be a little faster - it sure doesn't flicker and i think it meets omsec's requirements. but this is just to be thought of as a little improvement to kretzschmar's answer for his is (in essence) of nearly the same functionality. und, at last, when findtext is true, i select from findtext(which returns the position) to length of keyword and use setseltextbuf to overwrite the selected text buffer with the keyword. this could probably cause some trouble when not intended to behave so. but this could easily be changed...

i've fumbled around with this on thursday already and have no ambition to repeat this now because i have the code at home. so please don't push me. i'm gonna post this tomorrow. o.k.?

now have a nice evening and deal with something nice and cosy with skin and flesh and fur and breasts - soft and spicy...leather and lace...

.or have a BIG jack daniel's on the rocks...

or whatever you please.
at least, i'm goin' to do so.
right now.

bye,

Black Death.

btw: mayb you've implemented this be4 i'm goin' 2 arrive 2morrow...

it must be:
.zero) to the end of the text...
of course.

Black Death.

good morning, omsec, good morning, kretzschmar.

here's the trash version. i'm gonna work on it soon.
have a form with a richedit for this one.

(* i know this one is extremely ugly, but i'm not in the mood for any kind of
   optimization. in the first place this pile of crap's gotta run. and except
   the handling of ctrl-ins and ctrl-del i'm of the opinion it does.
   you know, i started this night at 9 p.m. and now it's 1.30 a.m.
   i leave it up to you to make this ugly beast a nice little princess.

   maybe you send me your result: andreas.naguschewski@vt.siemens.de

   maybe tomorrow i feel some incliniation to polish a little bit all over
   it. if so, it goes without saying that i'll post it.
   so, now it's time for me to say goodbye - we'll meet later on. good night.

   Black Death.

   p.s.: it's quite sure i'm gonna polish - this one is too embarrasing. it is
         only to show which cases have to be watched. bye, Black.

   p.p.s: i'm quite sure there are still some bugs - but i didn't find them
          up to now. if you find one, tell me which or tell me the solution
          which would be better... so long, Death. *)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;

const
  sKeyWord: string = 'Synax';
  cSelColor: TColor = clRed;
  cDefColor: TColor = clBlack;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure RichEdit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private-Deklarationen }
    leKeyWord: Integer;
    boRemove: Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.RichEdit1Change(Sender: TObject);
var
  iCnt,
  iPos,
  iPrevPos: Integer;
  buf: PChar;
begin
  with RichEdit1 do begin

    // what is missing here?
    // can you guess?
    // right: the handling of ctrl-ins and ctrl-del
    // maybe you wanna implement this one, i don't (right now).

    // handle del and backspace
    if boRemove then begin
      // one character was removed, so set color to clDefault
      // in the range SelStart - leKeyWord to SelStart + leKeyWord;
      iPrevPos := SelStart;
      if SelStart < leKeyWord then begin
        SelStart := 0;
        SelLength := leKeyWord;
      end
      else begin
        SelStart := SelStart - leKeyWord;
        SelLength := 2 * leKeyWord;
      end;
      GetMem(buf, 2 * leKeyWord);
      iCnt := GetSelTextBuf(buf, 2 * leKeyWord);
      SelAttributes.Color := clDefault;
      SetSelTextBuf(buf);
      FreeMem(buf);
      SelStart := SelStart - iCnt;
      // rehighlight word left (in case of del)?
      if SelStart < leKeyWord then
        SelStart := 0
      else
        SelStart := SelStart - leKeyWord + 1;
      SelLength := Length(Text);
      iPos := FindText(sKeyWord, SelStart, Length(Text), []);
      if iPos > -1 then begin
        SelStart := iPos;
        SelLength := leKeyWord;
        SelAttributes.Color := cSelColor;
        SetSelTextBuf(PChar(sKeyWord));
        SelStart := iPrevPos;
        SelLength := 0;
      end;
      SelStart := iPrevPos;
      // rehighlight word right (in case of backspace)?
      SelLength := Length(Text);
      iPos := FindText(sKeyWord, SelStart, Length(Text), []);
      if iPos > -1 then begin
        SelStart := iPos;
        SelLength := leKeyWord;
        SelAttributes.Color := cSelColor;
        SetSelTextBuf(PChar(sKeyWord));
        SelStart := iPrevPos;
        SelLength := 0;
      end;
      SelStart := iPrevPos;
      Exit;
    end;
    // p.s.: the above handling is ****ty - you could as well test
    // immediately wether it was a del or a backspace (onkeydown) and then
    // only set the color to the appropriate direction to clDefault, but -
    // i'm too tired now to rewrite and test again...

    // are we WITHIN a selected text? if so, deselect
    if (SelAttributes.Color = cSelColor) and
       (SelStart > 0) and
       (SelStart < Length(Text)) and
       (Copy(Text, SelStart - leKeyWord, leKeyWord) <> sKeyWord) and
       (Copy(Text, SelStart, leKeyWord) <> sKeyWord) then begin
      SelStart := SelStart - 1;
      SelLength := 1;
      GetMem(buf, SelLength);
      GetSelTextBuf(buf, SelLength);
      ClearSelection;
      SelStart := SelStart + 1;
      if SelStart < leKeyWord then
        iPos := FindText(sKeyWord, 0, leKeyWord, [])
      else
        iPos := FindText(sKeyWord, SelStart - leKeyWord, leKeyWord, []);
      if (iPos > -1) then begin
        iPrevPos := SelStart;
        SelStart := iPos;
        SelLength := leKeyWord;
        SelAttributes.Color := cDefColor;
        SetSelTextBuf(PChar(sKeyWord));
        SelStart := iPrevPos;
        SelStart := SelStart - 1;
        SelLength := 0;
        SetSelTextBuf(buf);
      end;
      FreeMem(buf);
    end;

    // are we at the end of a keyword? if so, set default color
    if (Copy(Text, SelStart - leKeyword, leKeyWord) = sKeyWord) then begin
      SelStart := SelStart - 1;
      SelLength := 1;
      GetMem(buf, 1);
      GetSelTextBuf(buf, 1);
      SelAttributes.Color := cDefColor;
      SetSelTextBuf(buf);
      FreeMem(buf);
    end;

    // and now the normal handling
    // (btw: the following part of code was my original code, all the junk above
    //  came this night when testing the borderline cases...)
    // (ps: and - o.k., i've lied - it flickers. but only after implementing all
    //  that **** above, before it didn't...)
    if SelStart < leKeyWord then
      iPos := FindText(sKeyWord, 0, leKeyWord, [])
    else
      iPos := FindText(sKeyWord, SelStart - leKeyWord, leKeyWord, []);
    if (iPos > -1) then begin
      iPrevPos := SelStart;
      SelStart := iPos;
      SelLength := leKeyWord;
      SelAttributes.Color := cSelColor;
      SetSelTextBuf(PChar(sKeyWord));
      SelStart := iPrevPos;
      SelLength := 0;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  leKeyWord := Length(sKeyWord);
  RichEdit1.SelAttributes.Color := cDefColor;
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_BACK,
    VK_DELETE: boRemove := True
  else
    boRemove := False;
  end;
end;

end.


so long,

Black Death.

hey Black Death, thanx...

You're in Germany ?? Cool,I'm in Switzerland :)
geil, dass hier einer deutsch redet :P

well, i just looked quickly on your code yet, i think i dont have time the next days anyway, not before next week. I have to do quite a lot at work/school and my boss "hunts" me from there to there, but thanx, i'll check it out later...

hallo, omsec.
woran hastes erkannt?

am "ach" oder an den (von delphi eingestreuten) kommentaren in der object-declaration?
oder am profil?

egal. weißte, es gibt hier haufenweise deutschsprachige freaks (frete, bome, madshi, _omsec_ and i don't know how much more...)

o.k. gimme your eMail-address, accept kretzschmar's answer and wait for the next version i'm gonna send you directly; meanwhile you can test this one and tell me if it works the way it is supposed to.

you can obtain my eMail-address by my profile including some more information.

so long & have a nice weekend.

Black Death.

btw: are you in alles-o.k.?

4get about the eMail-address, i'll take rbieri@centralnet.ch from your profile. o.k.?

;-)=)

Black.

yep, thats my current address

Hi omsec, hi Blackdeath,

well done blackdeath, your code works fine. Just tested it.

Übrigens auch ich spreche deutsch. Omsec, du kannst meine Antwort verwerfen. Blackdeath's Code ist besser. Soviel Kopfarbeit sollte honoriert werden.

hey BlackDeath kannste mir auch deine final version mailen. eMail Adresse ist im Profil.

The work is at yours.

meikl

sure, alter.

willkommen im club

Black Death.

Heh, just as a blatant advert, you could have a look at

http://www.ffa-software.freeserve.co.uk/

and download a shareware component from there

Tim.

PS:  Sorry for the blatant advert, but it _is_ shareware after all :)

btw, how could i enhance this proc to support some common program language's syntax too, especially the comments thing sch as

[some text] // Here a Comment till EOL

[some text] { COmment inside a text} [more text]

var
 nPos : integer;
begin
nPos := pos('//', richedit.text);
if nPos  > 0 then begin
  richedit.sellength(nPos, Length(richedit.lines.string[currentline])-nPos);
  richedit.selattributes.color := clRed;
  richedit.sellength := 0;
end;
end;

and so on...

Cheers,
Viktor†