Richedit how to highlight a defined word in memofields ?

[ukoenig]

Cristobal,

there are to many problems like unformatted text unexpected side-effect using lhighlight := .t.
Why not define extra keywords for textcolouring like the links
Richedit includes fixed defines for hightlighting
If You test the forum-import-tool, richedit is working fine and shows the memofield
( still textcolouring of defined keywords is missing )



regards
Uwe

[cnavarro]

Sorry, then I did not understand well
Can you give me a small complete example to see what he wants to tell me?
Remember that my English is very poor

[Marc Venken]

Uwe,

The first post, was it not working ok for you ?

It seems to do what is needed

[ukoenig]

Cristobal,

I only defined

@ 70, 625 RICHEDIT5 oTCode VAR cTCode OF oDlg SIZE 600, 380 ; // w h
FONT oFont PIXEL HSCROLL

NO function-call and nothing special
The result is shown on the screenshot
Maybe it would be a good idea to create a minimized sample

regards
Uwe

[Marc Venken]

There is a simple sample above, but with Richtedit2. Maybe adjust it to 5 ?

Then we can play with it and find a solution.

Marc

[AntoninoP]

the richedit automatically highlight the url.
About colorize, I have an optimized version:

Code: Select all  Expand view  RUN

method Colorize(nStart, nEnd, nColor) CLASS TLRICHEDIT5
   ::SetSel( nStart, nEnd )
   RESetColor(::hWnd, nColor)
return nil

where RESetColor is

Code: Select all  Expand view  RUN

HB_FUNC( RESETCOLOR )
{
   HWND hWnd = (HWND) fw_parh(1);
   CHARFORMAT cf;
   memset(&cf, 0, sizeof(cf));
   cf.cbSize = sizeof(cf);
   cf.dwMask = CFM_COLOR;
   cf.crTextColor = hb_parnl(2);
   SendMessage(hWnd, EM_SETCHARFORMAT, SCF_SELECTION, (LPARAM)&cf);
}

that is simpler and about 1/3 faster

[ukoenig]

Antonino,

thank You for the info

The download of the browser- and richedit section with full source for testing.
http://www.pflegeplus.com/DOWNLOADS/Forum9.zip

The source is kept small in size as possible ( no graphics and colours ) and works with the original forum-import samples1.dbf
The keyword defined inside the browser ( xbrowse-keyword-field ) needed to be coloured.

I'm planning the possibility to add own topics to the list and copy / past sections from other topics to this new one.
Is it possible to do some changes to the richedit and saving it back to the MEMO ?
The < New > and < Save > -buttons are included for testing.



regards
Uwe

[cnavarro]

Uwe, it's solved your question?

[ukoenig]

Cristobal,

No, that is the reason for the download. Without colouring it works fine.
Using another solution the text is not formatted and shows a missing linefeed.
That happens adding
@ 70, 625 RICHEDIT5 oTCode VAR cTCode OF oDlg SIZE 600, 380 ; // w h
FONT oFont PIXEL HSCROLL

regards
Uwe

[cnavarro]

Uwe, I not look problem, please explain more

[ukoenig]

Cristobal,

maybe it is possible to include the logic from Richedit-hightlight method
We have to scan each line for the keyword(s)

The return-values of the included messages are ok but the colouring of the area doesn't work

Code: Select all  Expand view  RUN

:bChange := { || cTKeyWord1 := UPPER(ALLTRIM((cFileName)->INFO1)), ;
   cTKeyWord2 := UPPER(ALLTRIM((cFileName)->INFO2)), ;
   cTopic := ALLTRIM((cFileName)->TOPIC), ;
   oTopic:SetText( cTopic ), ;
   SHOW_KEYW( oTopic, cTopic, cTKeyWord1, cTKeyWord2 ), ;
   cTCode := (cFileName)->CODE, ;
   oTCode:SetText( cTCode ), ;
   SHOW_KEYW( oTCode, cTCode, cTKeyWord1, cTKeyWord2 ), ;                  
   TCode:GoToLine( 1 ) }
...
...

// ----------------- Check each line -----------

FUNCTION SHOW_KEYW( oCode, cCode, cKeyWord1, cKeyWord2 )
LOCAL nPos := 20, nLen := 50, nLine

FOR nLine := 1 to oCode:GetLineCount() //  Scan line by line
       THIGHLIGHT( nLine, oCode, cCode, cKeyWord1, cKeyWord2 )
       SysRefresh()
NEXT

RETURN NIL

// ----------------- Keyword hightlight ----------

FUNCTION THIGHLIGHT( nLine, oCode, cCode, cKeyWord1, cKeyWord2 )
local cLine := ""
local nAt   := 1
local nAt1  := 0
local nAt2  := 0
local nSep := 0
local nLen  := 0
local nGetSel := oCode:SendMsg( EM_GETSEL )

oCode:aKeywords1  = { cKeyWord1, cKeyWord2 }
oCode:GoTo( nLine )
oCode:SendMsg( 11, 0, 0 )

// review keywords in current line to highlight them
cLine = StrTran( oCode:GetLine( nLine ), Chr( 13 ), "" ) // result cLine = Linetext
nLen = Len( cLine )

nAt1 := AT( cKeyWord1, UPPER(cLine) )  
nAt2 := AT( cKeyWord2, UPPER(cLine) )  
IF nAt1 > 0
    MsgAlert( cLine, "Line" + "  ->> " + ALLTRIM( STR(nLine)) )
    MsgAlert( nAt1, "Left 1" )
    MsgAlert( LEN( cKeyWord1 ), "Len Keyword 1" )
    oCode:Colorize( nAt1, LEN( cKeyWord1 ), 255 )
ENDIF
IF nAt2 > 0
    MsgAlert( cLine, "Line" + "  ->> " + ALLTRIM( STR(nLine)) )
    MsgAlert( nAt2, "Left 2" )
    MsgAlert( LEN( cKeyWord2 ), "Len Keyword 2" )
    oCode:Colorize( nAt2, LEN( cKeyWord2 ), 255 )
ENDIF

// Let the control be painted
oCode:SendMsg( 11, 1, 0 )
InvalidateRect( oCode:hWnd )

RETURN NIL
 

regards
Uwe

[cnavarro]

Uwe, sorry for the time in answering
Made with your logic

1.- Your :bChange codeblock is Ok
2.- Remove clause highlight ( not need for this topic )
3.- Please apply this functions and tell me

Code: Select all  Expand view  RUN

//----------------------------------------------------------------------------//

Function SHOW_KEYW( oCode, cCode, cKeyWord1, cKeyWord2 )

   Local nLine := 0
   
   FOR nLine := 1 to oCode:GetLineCount()
      THIGHLIGHT( nLine, oCode, cCode, cKeyWord1, cKeyWord2 )
   NEXT

Return nil

//----------------------------------------------------------------------------//

FUNCTION THIGHLIGHT( nLine, oCode, cCode, cKeyWord1, cKeyWord2 )

   local cLine := ""
   local nAt   := 1
   local nAt1  := 0
   local nAt2  := 0
   local nPos1 := 0
   local nPos2 := 0

   oCode:GoTo( nLine - 1 )
   cLine       := Upper( oCode:GetLine( nLine ) )

   if !Empty( cKeyWord1 )
      nAt1     := At( Upper( AllTrim( cKeyWord1 ) ), cLine )  
      IF nAt1 > 0
          nPos1   := oCode:GetPos() + nAt1 - 1
          nPos2   := nPos1 + Len( AllTrim( cKeyWord1 ) )
          oCode:Colorize( nPos1, nPos2, 255 )
      endif
   endif

   if !Empty( cKeyWord2 )
      if ( nAt2 := AT( Upper( AllTrim( cKeyWord2 ) ), cLine ) > 0 )
         nPos1   := oCode:GetPos() + nAt1 - 1
         nPos2   := nPos1 + Len( AllTrim( cKeyWord1 ) )
         oCode:Colorize( nPos1, nPos2, 255 )
      endif
   endif

Return nil

//----------------------------------------------------------------------------//

 

[cnavarro]

Also, look this
( Remove clause highlight ( not need for this topic ) )

Code: Select all  Expand view  RUN

      :bChange := { || cTopic     := Alltrim((cFileName)->TOPIC), ;
                       oTopic:SetText( cTopic ), ;
                       oTopic:aKeyWords1  := ;
                       oTCode:aKeyWords1  := { Alltrim( ( cFileName )->INFO1 ), ;
                       Alltrim( ( cFileName )->INFO2 ) }, ;
                       oTopic:nClrKey1    := ;
                       oTCode:nClrKey1    := CLR_HCYAN, ;
                       SHOW_KEYW( oTopic ), ;
                       cTCode := ( cFileName )->CODE, ;
                       oTCode:SetText( cTCode ), ;
                       SHOW_KEYW( oTCode ), ;
                       oTCode:GoToLine( 1 ) }


..../....

//----------------------------------------------------------------------------//

Function SHOW_KEYW( oCode )

   Local nLine := 0
   
   FOR nLine := 1 to oCode:GetLineCount()
      THIGHLIGHT( nLine, oCode )
   NEXT

Return nil

//----------------------------------------------------------------------------//

FUNCTION THIGHLIGHT( nLine, oCode )

   local cLine := ""
   local nAt   := 1
   local nAt1  := 0
   local nAt2  := 0
   local nPos1 := 0
   local nPos2 := 0
   local x

   oCode:GoTo( nLine - 1 )
   cLine       := Upper( oCode:GetLine( nLine ) )
   For x = 1 to Len( oCode:aKeyWords1 )
      if !Empty( oCode:aKeyWords1[ x ] )
         nAt1     := At( Upper( oCode:aKeyWords1[ x ] ), cLine )
         if nAt1 > 0
             nPos1   := oCode:GetPos() + nAt1 - 1
             nPos2   := nPos1 + Len( oCode:aKeyWords1[ x ] )
             oCode:Colorize( nPos1, nPos2, oCode:nClrKey1 )
         endif
      endif
   Next x

Return nil

//----------------------------------------------------------------------------//
 

[ukoenig]

Cristóbal,

thank You very much.
That is exactly the solution I've been looking for
A clean textpreview without any flickering.

Now I can finish the forum-sample-import.



regards
Uwe

[Antonio Linares]

Could we create a PRG to import all forums posts to a DBF ?

How to know how many posts a forum has ?

How to know in a specific topic, what the next post ?

Could we have a function ForumGetPost( ... ) that returns an array or an object with ?

1. Title (topic)
2. Date
3. Author
4. Next post in topic
5. Contents
6. Forum that belongs to
7. number of views (?)
8. what else ?

that would be great!