Please login or register.
1 Hour 1 Day 1 Week 1 Month Forever
Login with username, password and session length

thanks Paul,

now i can move forward again.
Perhaps it is useful to add the function to WinFBE

I have a program where I need to set the color/font of certain RTF text. Here is the generic code that I use:

rtfText( hEdit, wszText, wszFontName, nFontSize, CFE_BOLD, colors.Black )

Code: [Select]

' ========================================================================================
' rtfText
' General purpose routine to set the font, size, effect, color for text to be entered.
' ========================================================================================
function rtfText( byval hEdit as HWND, _
                  byval wszText as CWSTR, _
                  byval wszFontName as CWSTR, _
                  byval nFontSize as long, _
                  byval nFontEffect as long = 0, _
                  byval nFontColor as COLORREF = 0 _
                  ) as Long
                 
   dim hDC AS HDC
   dim lRet AS LONG
   dim cf AS CHARFORMAT2
   DIM tlf AS LOGFONTW
   
   dim stex as SETTEXTEX
   stex.flags = ST_SELECTION or ST_UNICODE

   hDC = GetDC(NULL)
   EnumFontFamiliesW( hDC, byval wszFontName, cast(FONTENUMPROCW, @RichEdit_EnumFontFamProcW), cast(LPARAM, @tlf) )
   ReleaseDC NULL, hDC

   cf.cbsize = sizeof(cf)
   cf.dwMask = CFM_FACE OR CFM_CHARSET or CFM_SIZE or _
               CFM_BOLD OR CFM_ITALIC OR CFM_UNDERLINE OR CFM_STRIKEOUT or _
               CFM_COLOR
   cf.szFaceName      = tlf.lfFaceName
   cf.bCharSet        = tlf.lfCharSet
   cf.bPitchAndFamily = tlf.lfPitchAndFamily
   cf.yHeight         = nFontSize * 20
   cf.dwEffects       = nFontEffect
   cf.crTextColor     = nFontColor
   
   SendMessage( hEdit, EM_SETCHARFORMAT, SCF_SELECTION, cast(LPARAM, @cf) )
   RichEdit_SetTextExW( hEdit, @stex, wszText )
   
   function = 0
end function
 


Hello people,

how can I change the text color in a RichEdit control?

Code: [Select]


With frmMain.RichEdit1
            .SelectionStart = 0
            .SelectionLength = 5
          '  .SelectionColor = RGB(0, 0, 255) ' Blue ???
End with


Maybe it's not built in yet ?, can I do it in a different way?

Thanks, Paul,
Perfect, BeginUpdate and EndUpdate worked in do_colour_event_types without error 6 and was very fast. However, BeginUpdate and EndUpdate are still throwing error 6 in the code that adds rows and cols.

Hi Paul,
In my code,  BeginUpdate and EndUpdate are throwing Error 6, There are 2 ListView controls on a form and regardless of whether or not there is any code between BeginUpdate and EndUpdate an error 6 is thrown for each ListView, but, it doesn't invoke the error handler. Print GetLastError() catches the error (and clears it).

Code: [Select]


With frmMainJ.lvEntryType       
        .BeginUpdate
        .Items.Clear '' Leave here, faster update.       
        For i As Integer = LBound( accumulator ) To UBound( accumulator )   
            j = .Items.Add( Left( accumulator( i ), 10 ) )
            Dim As String s = Mid(  accumulator( i ), 12, 50 )
            .Item( j ).SubItems.Add( s )
            Print GetLastError() ' prints 6 once per loop
        Next i
        .EndUpdate
End with
Comment out BeginUpdate and EndUpdate results in no error but refresh is slow.

Thanks Steven - I have noted your post and will investigate (I just have two other issues ahead of this one).

Hi Clive, I am not at my development computer but looking at your code that you posted I don't see BeginUpdate / EndUpdate code as part of your routines. To speed up the recolor I expect that if you change your do_colour_event_types function to the following then it should be a lot faster:

Code: [Select]

Sub do_colour_event_types( ByRef ListView as wfxListView, ByVal this_type as Long, ByVal caller As String = "Unknown" )
    '? "do_colour_event_types"; caller
    ListView.BeginUpdate

    For i as Integer = 1 to 30
        If js( jdb.RecPtr ).Entry_Type( i ) = this_type OrElse js( jdb.RecPtr ).Entry_Category( i ) = this_type then
            '' User select
            set_row_colour( ListView, colors.Blue, 0 , i - 1 )           
        ElseIf js( jdb.RecPtr ).Entry_Type( i ) =  jdb.Entry_Modifier( "Done" ) OrElse js( jdb.RecPtr ).Entry_Category( i ) = jdb.Entry_Modifier( "Done" ) then           
            set_row_colour( ListView, colors.Gray, 0 , i - 1 )           
        ElseIf js( jdb.RecPtr ).Entry_Type( i ) =  jdb.Entry_Modifier( "Daily" ) OrElse js( jdb.RecPtr ).Entry_Category( i ) = jdb.Entry_Modifier( "Daily" ) then           
            set_row_colour( ListView, colors.DarkRed , 0 , i - 1 )   
        Else
            set_row_colour( ListView, colors.SystemWindowText, 0 , i - 1 )           
        End If
    Next i

    ListView.EndUpdate

    '' Refresh is only required to display colour changes if

    '' wfxListView.inc, AfxRedrawWindow(this.hWindow) is commented out.
    'If IsWindowVisible( ListView.hWindow ) Then '' Required?
        ' ListView.Refresh
    'End If
End Sub


Hi Paul,
(Using the 2 files you posted yesterday)
This line compiles okay, but has no effect:

Code: [Select]

frmMainJ.lvJournal.OddRowColorEnabled = False
The more text in the ListView, the longer the refresh.
With all of the following code removed, the average refresh is about 60ms, added back in, the refresh ranges between 2500ms and 6500ms.
Here is that code:

Code: [Select]


Sub set_row_colour( ByRef ListView as wfxListView, ByVal fg as COLORREF, ByVal bg as COLORREF, ByVal ubRow as UByte, ByVal caller As String = "Unknown" )
    With ListView
        For iCol as Long = 0 to 5
            .Item( ubRow ).SubItem( iCol ).ForeColor = fg '' <-- Comment out this line and the refresh time is about 70ms
        Next iCol
    End With
End Sub
''
''
Sub do_colour_event_types( ByRef ListView as wfxListView, ByVal this_type as Long, ByVal caller As String = "Unknown" )
    '? "do_colour_event_types"; caller
    For i as Integer = 1 to 30
        If js( jdb.RecPtr ).Entry_Type( i ) = this_type OrElse js( jdb.RecPtr ).Entry_Category( i ) = this_type then
            '' User select
            set_row_colour( ListView, colors.Blue, 0 , i - 1 )           
        ElseIf js( jdb.RecPtr ).Entry_Type( i ) =  jdb.Entry_Modifier( "Done" ) OrElse js( jdb.RecPtr ).Entry_Category( i ) = jdb.Entry_Modifier( "Done" ) then           
            set_row_colour( ListView, colors.Gray, 0 , i - 1 )           
        ElseIf js( jdb.RecPtr ).Entry_Type( i ) =  jdb.Entry_Modifier( "Daily" ) OrElse js( jdb.RecPtr ).Entry_Category( i ) = jdb.Entry_Modifier( "Daily" ) then           
            set_row_colour( ListView, colors.DarkRed , 0 , i - 1 )   
        Else
            set_row_colour( ListView, colors.SystemWindowText, 0 , i - 1 )           
        End If
    Next i
    '' Refresh is only required to display colour changes if

    '' wfxListView.inc, AfxRedrawWindow(this.hWindow) is commented out.
    'If IsWindowVisible( ListView.hWindow ) Then '' Required?
        ' ListView.Refresh
    'End If
End Sub
I hope this is helpful.

TextBox's KeyPress parameter "Handled" has been set to "true", but is always ignored in OnKeyPress.

For my test, I am using a 1000 row ListView with 4 columns. All cells get recolored (foreground and background) whenever I press a button. The average time to recolor is 0.015 seconds. That's pretty fast and I don't see any visual on-screen flicker.


Here is the recolor routine that I am using:

Code: [Select]

Sub set_rows_colour( byref ListView as wfxListView, ByVal bg as COLORREF, byval fg as COLORREF )
   ? "Recolor start: "
   dim as double t1, t2
   t1 = timer
   With ListView
      ' Because we are manually setting specific foreground and
      ' background colors, we do not want any color defined for
      ' the OddRowColor property to interfere.
      .OddRowColorEnabled = false
      .BeginUpdate
      For iRow as long = 0 to .Items.Count - 1
         For iCol as long = 0 to .Item(iRow).SubItems.Count - 1
            .Item(iRow).SubItem(iCol).ForeColor = fg
            .Item(iRow).SubItem(iCol).BackColor = bg
         next iCol
      Next iRow
      .EndUpdate
   End With
   t2 = timer
   ? "Recolor end: "; t2 - t1; " seconds."
End Sub