2003-12-25 07:46

'======= working example of   changing  background color of a selected text ==================
     $INCLUDE "Rapidq.inc" '     !    color definitions clRed, ets..

     DECLARE FUNCTION SendMessageA LIB "user32" ALIAS "SendMessageA"_
      (BYVAL hwnd AS LONG,BYVAL wMsg AS LONG,BYVAL wParam AS LONG,lParam AS LONG) AS LONG

     CONST WM_USER = &H400
     CONST CFM_BACKCOLOR = &H4000000
     CONST EM_SETCHARFORMAT = WM_USER + 68
     CONST EM_FORMATRANGE = WM_USER + 57
     CONST SCF_SELECTION = &H0001
     CONST EM_SETBKGNDCOLOR  =WM_USER + 67
     CONST SCF_ALL                 = 4

     CONST    CFM_BOLD              = &H00000001
     CONST    CFM_ITALIC            = &H00000002
     CONST    CFM_UNDERLINE         = &H00000004
     CONST    CFM_STRIKEOUT         = &H00000008
     CONST    CFM_PROTECTED         = &H00000010
     CONST    CFM_SIZE              = &H80000000
     CONST    CFM_COLOR             = &H40000000
     CONST    CFM_FACE              = &H20000000
     CONST    CFM_OFFSET            = &H10000000
     CONST    CFM_CHARSET           = &H08000000
     CONST    CFE_BOLD              = &H0001
     CONST    CFE_ITALIC            = &H0002
     CONST    CFE_UNDERLINE         = &H0004
     CONST    CFE_STRIKEOUT         = &H0008
     CONST    CFE_PROTECTED         = &H0010
     CONST    CFE_AUTOCOLOR         = &H40000000

     CONST    LF_FACESIZE =32


     TYPE CHARFORMAT1 '- size is 60 bytes'
      cbSize AS SHORT        '1     2 bytes
      wPad1 AS SHORT        '2    2 bytes
      dwMask  AS DWORD     '3'   4 bytes
      dwEffects AS DWORD     '4'  4 bytes
      yHeight AS DWORD         '5'  4 bytes
      yOffset AS DWORD ' > 0 for superscript, < 0 for subscript  '6' 4 bytes
      crTextColor AS LONG      '7  4 bytes
      bCharSet AS BYTE           '8 1 bytes
      bPitchAndFamily AS BYTE        '9' 1 bytes
      szFaceName AS STRING*32          '0'32 bytes
      wPad2  AS  SHORT'                      '1' 2 bytes
     END TYPE

     TYPE CHARFORMAT2 '-- Size is 84 bytes'
      cbSize AS SHORT        '2'
      wPad1 AS SHORT                              '2
      dwMask AS LONG                              '4
      dwEffects AS LONG                           '4'
      yHeight AS LONG                             '4
      yOffset AS LONG                             '4
      crTextColor AS LONG                         '4'
      bCharSet AS BYTE                            '1'
      bPitchAndFamily AS BYTE                     '1'
      szFaceName AS STRING*32      '0'32 bytes
      wPad2 AS SHORT                              '-- 2  CHARFORMAT end --- 60 bytes
      wWeight AS SHORT                            '2'
      sSpacing AS SHORT                           '2'
      crBackColor AS LONG                         '4'
      lLCID AS LONG                               '4
      dwReserved AS LONG                          '4'
      sStyle AS SHORT                             '2
      wKerning AS SHORT                           '2'
      bUnderlineType AS BYTE                      '1'
      bAnimation AS BYTE                          '1'
      bRevAuthor AS BYTE                          '1'
      bReserved1 AS BYTE                          '1'
     END TYPE

     DECLARE SUB Highlight (Sender AS QBUTTON)

     CREATE Form AS QFORM
      Width = 750
      Height = 531
      Center
      CREATE Panel1 AS QPANEL
       Height = 57
       Align = 1
       CREATE Button1 AS QBUTTON
        CAPTION = "Highlight Text"
        Left = 8
        Top = 8
        Width = 171
        OnClick = Highlight
       END CREATE
      END CREATE

      CREATE Panel2 AS QPANEL
       Align = 5
       TabOrder = 1
       CREATE RichEdit AS QRICHEDIT
        Align = 5
        HideSelection = 0
        ScrollBars = 3
        WantTabs = 1
        AddStrings "This is a test.  This is a Test. -------------------------------"
        SelStart = 0
        SelLength = 15
       END CREATE
      END CREATE
     END CREATE

     Form.SHOWMODAL

'--------- Subroutines ---------

'-- *************************************************************'
     SUB Highlight (Sender AS QBUTTON)
      DIM M AS QMEMORYSTREAM
      DIM CharFormat AS CHARFORMAT2

      CharFormat.dwMask = CFM_BACKCOLOR 'CFM_COLOR'''
      CharFormat.crBackColor =clYellow
'CharFormat.crTextColor  =clRed'' &H00223344

      PRINT  SIZEOF(CharFormat)
      CharFormat.cbSize =SIZEOF(CharFormat)
'print CharFormat.cbSize

      M.Position=0
      M.WriteUDT(CHARFORMAT)
      z=SendMessageA(RichEdit.Handle, EM_SETCHARFORMAT, SCF_SELECTION, M.Pointer)

      PRINT "SendMessageA return=",z
     END SUB
'=============================================
'With best regards, Andrew Shelkovenko.
'http://www.kolomyagi.spb.ru/~diakin66/rqsr/

2003-12-25 07:46