Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

DDT Richedit sample - Color text

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • DDT Richedit sample - Color text

    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Note: corrected for the latest RichEdit.inc, Feb 17, 2004
    '
    ' Small RichEdit sample, showing how to create a Richedit control
    ' and mark all occurrences of searched text with a specific color.
    ' With some tweaking - the base for a color syntax editor?
    ' It even has drag&drop editing..  :-)
    ' By Borje Hagsten, released as Public Domain - April 24, 2000
    '--------------------------------------------------------------------
    #COMPILE EXE
    #DIM ALL
     
    #INCLUDE "WIN32API.INC" 'Some include files
    #INCLUDE "COMMCTRL.INC"
    #INCLUDE "RICHEDIT.INC"
     
    %ID_RICHEDIT  = 500
     
    GLOBAL hEdit AS LONG
     
    DECLARE CALLBACK FUNCTION DlgCallback()
    DECLARE FUNCTION MarkAll (BYVAL myText AS STRING) AS LONG
    DECLARE FUNCTION setRichTextColor( BYVAL NewColor AS LONG) AS LONG
     
     
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Main program entrance 
    '--------------------------------------------------------------------
    FUNCTION PBMAIN
        LOCAL hDlg AS LONG, hRichEd AS LONG, rText AS STRING
     
        hRichEd = LoadLibrary("RICHED32.DLL")
        CALL InitCommonControls
     
        DIALOG NEW 0, "DDT RichEdit demo",,, 200, 138, %WS_SYSMENU TO hDlg
        CONTROL ADD BUTTON, hDlg, %IDOK,     "&Mark",  140,  6, 50, 14
        CONTROL ADD BUTTON, hDlg, %IDCANCEL, "E&xit", 140, 22, 50, 14
     
        CONTROL ADD "RichEdit", hDlg, %ID_RICHEDIT, "", 6, 6, 126, 110, _
                    %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR _
                    %WS_HSCROLL OR %ES_AUTOVSCROLL OR %ES_WANTRETURN OR  _
                    %ES_NOHIDESEL, %WS_EX_CLIENTEDGE
     
        CONTROL HANDLE hDlg, %ID_RICHEDIT TO hEdit
     
        rText = REPEAT$(30, "Start and Stop ") 'Create and set some text
        CALL SendMessage(hEdit, %WM_SETTEXT, 0, STRPTR(rText))
        SetFocus hEdit
         
        DIALOG SHOW MODAL hDlg CALL DlgCallback
     
    END FUNCTION
     
     
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' setRichTextColor sets the textcolor for selected text or
    ' text at the cursor's place in a Richedit control. Example:
    ' CALL setRichTextColor(&HFF) sets the color to red.
    ' &HFF0000 is blue, &H8000 is dark green, &H0 is black, etc..
    '--------------------------------------------------------------------
    FUNCTION setRichTextColor( BYVAL NewColor AS LONG) AS LONG
      LOCAL cf AS CHARFORMAT
     
      cf.cbSize      = LEN(cf)     'Length of structure
      cf.dwMask      = %CFM_COLOR  'Set mask to colors only
      cf.crTextColor = NewColor    'Set the new color value
     
      CALL SendMessage(hEdit, %EM_SETCHARFORMAT, %SCF_SELECTION, VARPTR(cf))
     
    END FUNCTION
     
     
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' This is a simple "find all" Function
    '--------------------------------------------------------------------
    FUNCTION MarkAll (BYVAL myText AS STRING) AS LONG
       LOCAL AllText AS STRING, tLen AS LONG, stopPos AS LONG
     
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       'Put Richedit's contents into a string
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       tLen = SendMessage(hEdit, %WM_GETTEXTLENGTH, 0, 0) + 1
       AllText = SPACE$(tLen)
       CALL SendMessage(hEdit, %WM_GETTEXT, tLen, STRPTR(AllText))
     
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ' Turn off redraw to get faster and smoother action
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       CALL SendMessage(hEdit, %WM_SETREDRAW, 0, 0)
     
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ' Loop through string, pick out positions, select occurrences and then paint
       ' Note - Instr returns pos +1 in regards to Selstart, so we have to use -1
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       stopPos = INSTR(AllText, myText)
       DO WHILE stopPos
          CALL SendMessage(hEdit, %EM_SETSEL, stopPos - 1, stopPos + LEN(myText) - 1)
          CALL setRichTextColor(&HFF) '&FF = red
          stopPos = INSTR(stopPos + LEN(myText) - 1, AllText, myText)
       LOOP
       CALL SendMessage(hEdit, %EM_SETSEL, 0, 0)
       SetFocus hEdit   'SetFocus to activate it after work is done, if you like..
     
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ' Turn on Redraw again and refresh
       '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       SendMessage hEdit, %WM_SETREDRAW, 1, 0 'Refresh and reset redraw
       InvalidateRect hEdit, BYVAL %NULL, 0 : UpdateWindow hEdit
     
    END FUNCTION
     
     
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Main callback procedure for all controls
    '--------------------------------------------------------------------
    CALLBACK FUNCTION DlgCallback()
      IF CBMSG = %WM_COMMAND THEN
        SELECT CASE CBCTL
          CASE %IDOK
             CALL MarkAll("Stop") ' "Stop", or any text you'd like to mark
     
          CASE %IDCANCEL
            DIALOG END CBHNDL, (CBCTL = %IDOK)
     
        END SELECT
      END IF
    END FUNCTION


    [This message has been edited by Borje Hagsten (edited February 17, 2004).]
Working...
X