Setting lines in a scrollable text window to different colors

[fan42025]

In the scrollable text window template, how does one go about to set each each line to different colors?

Code Select Expand

' ########################################################################################
' Microsoft Windows
' File: CW_ScrollWindow.fbtpl
' Contents: Scrollable window
' Compiler: Free Basic
' Copyright (c) 2016 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx

#define IDC_LISTBOX 1001

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   DIM pWindow AS CWindow
   DIM hwndMain AS HWND = pWindow.Create(NULL, "Scrollable window", @WndProc)
   pWindow.ClassStyle = CS_DBLCLKS   ' // Change the window style to avoid flicker
   ' // Set a client size big enough to display all the controls
   pWindow.SetClientSize(320, 335)

   ' // Add a listbox
   DIM hListBox AS HWND
   hListBox = pWindow.AddControl("ListBox", , IDC_LISTBOX)
   pWindow.SetWindowPos hListBox, NULL, 8, 8, 300, 280, SWP_NOZORDER

   ' // Fill the list box
   DIM i AS LONG, wszText AS WSTRING * 260
   FOR i = 1 TO 50
      wszText = "Item " & RIGHT("00" & STR(i), 2)
      ListBox_AddString(hListBox, @wszText)
   NEXT
   ' // Select the first item
   ListBox_SetCursel(hListBox, 0)

   ' // Add a cancel button
   pWindow.AddControl("Button", , IDCANCEL, "&Cancel", 233, 298, 75, 23)

   ' // Create an instance of the CScrollWindow class and attach the main window to it
   DIM pScrollWindow AS CScrollWindow PTR = NEW CScrollWindow(hwndMain)
   ' // Store the pointer in the class of the parent window for later deletion
   pWindow.ScrollWindowPtr = pScrollWindow
   ' // Shrink the client size
   pWindow.SetClientSize(250, 260)
   ' // Center the window
   pWindow.Center

   

   ' // Dispatch windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window callback procedure
' ================================================================e========================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         CASE IDC_LISTBOX
            SELECT CASE GET_WM_COMMAND_CMD(wParam, lParam)
               CASE LBN_DBLCLK
                  ' // Get the handle of the Listbox
                  DIM hListBox AS HWND = GetDlgItem(hwnd, IDC_LISTBOX)
                  ' // Get the current selection
                  DIM curSel AS LONG = ListBox_GetCursel(hListBox)
                  ' // Get the length of the ListBox item text
                  DIM nLen AS LONG = ListBox_GetTextLen(hListBox, curSel)
                  ' // Allocate memory for the buffer
                  DIM pwszText AS WSTRING PTR = CAllocate(nLen + 1, 2)
                  ' // Get the text and display it
                  ListBox_GetText(hListBox, curSel, pwszText)
                  MessageBoxW(hwnd, pwszText, "ListBox test", MB_OK)
                  ' // Deallocate the memory used by the buffer
                  DeAllocate pwszText
                  pwszText = NULL

                  ' *** Alternate way using CWSTR ***
'                  DIM cwsText AS CWSTR = ListBox_GetTextLen(hListBox, curSel) + 1
'                  ListBox_GetText(hListBox, curSel, *cwsText)
'                  MessageBoxW(hwnd, cwsText, "ListBox test", MB_OK)

                  EXIT FUNCTION
            END SELECT

         END SELECT

      CASE WM_SIZE
         DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
         IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
         EXIT FUNCTION

      CASE WM_VSCROLL
         DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
         IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
         EXIT FUNCTION

      CASE WM_HSCROLL
         DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
         IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
         EXIT FUNCTION

      CASE WM_DESTROY
         ' // End the application
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to DefWindowProc
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


[Paul Squires]

Here is an ownerdrawn listbox with double buffered graphics and alternate line coloring.

Code Select Expand

' ########################################################################################
' Microsoft Windows
' File: CW_ScrollWindow.fbtpl
' Contents: Scrollable window
' Compiler: Free Basic
' Copyright (c) 2016 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx

#define IDC_LISTBOX 1001

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   DIM pWindow AS CWindow
   DIM hwndMain AS HWND = pWindow.Create(NULL, "Scrollable window", @WndProc)
   pWindow.ClassStyle = CS_DBLCLKS   ' // Change the window style to avoid flicker
   ' // Set a client size big enough to display all the controls
   pWindow.SetClientSize(320, 335)

   ' // Add a listbox
   DIM hListBox AS HWND
   dim as dword dwStyle = WS_VISIBLE OR WS_HSCROLL OR WS_VSCROLL OR WS_BORDER OR WS_TABSTOP OR LBS_HASSTRINGS OR LBS_NOTIFY OR LBS_OWNERDRAWFIXED
   dim as dword dwExStyle = WS_EX_CLIENTEDGE

   hListBox = pWindow.AddControl("ListBox", , IDC_LISTBOX, "", 0, 0, 0, 0, dwStyle, dwExStyle)
   pWindow.SetWindowPos hListBox, NULL, 8, 8, 300, 280, SWP_NOZORDER

   ' // Fill the list box
   DIM i AS LONG, wszText AS WSTRING * 260
   FOR i = 1 TO 50
      wszText = "Item " & RIGHT("00" & STR(i), 2)
      ListBox_AddString(hListBox, @wszText)
   NEXT
   ' // Select the first item
   ListBox_SetCursel(hListBox, 0)

   ' // Add a cancel button
   pWindow.AddControl("Button", , IDCANCEL, "&Cancel", 233, 298, 75, 23)

   ' // Create an instance of the CScrollWindow class and attach the main window to it
   DIM pScrollWindow AS CScrollWindow PTR = NEW CScrollWindow(hwndMain)
   ' // Store the pointer in the class of the parent window for later deletion
   pWindow.ScrollWindowPtr = pScrollWindow
   ' // Shrink the client size
   pWindow.SetClientSize(250, 260)
   ' // Center the window
   pWindow.Center

   

   ' // Dispatch windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window callback procedure
' ================================================================e========================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      case WM_MEASUREITEM
         dim lpmis As MEASUREITEMSTRUCT Ptr = cast( MEASUREITEMSTRUCT Ptr, lParam )
         if lpmis andalso (wParam = IDC_LISTBOX) then
             lpmis->itemHeight = AfxScaleY(20)
         end if
         return true

      case WM_DRAWITEM
         Dim memDC as HDC      ' Double buffering
         Dim hbit As HBITMAP   ' Double buffering
         Dim As RECT rc
         Dim wszText As WString * MAX_PATH

         dim lpdis As DRAWITEMSTRUCT Ptr = cast( DRAWITEMSTRUCT Ptr, lParam )
         if lpdis = 0 then exit function

         if ( lpdis->itemAction = ODA_DRAWENTIRE ) orelse _
            ( lpdis->itemAction = ODA_SELECT ) orelse _
            ( lpdis->itemAction = ODA_FOCUS ) then
             
            If lpdis->itemID = -1 Then return true
            if lpdis->itemAction = ODA_FOCUS then return true

            dim as COLORREF clrBack, clrFore
            dim as HBRUSH hBrushBack
             
            rc = lpdis->rcItem
            dim as long nWidth  = rc.right-rc.left
            dim as long nHeight = rc.bottom-rc.top

            SaveDC(lpdis->hDC)

            memDC = CreateCompatibleDC( lpdis->hDC )
            hbit  = CreateCompatibleBitmap( lpdis->hDC, nWidth, nHeight )
            If hbit Then hbit = SelectObject( memDC, hbit )

            dim as HFONT _hFont = AfxGetWindowFont( lpdis->hwndItem )
            SelectObject( memDC, _hFont )

            ' CLEAR BACKGROUND
            If (lpdis->itemState And ODS_SELECTED) Then     
               clrBack = BGR(0,0,255)       ' blue
               clrFore = BGR(255,255,255)   ' white
               hBrushBack = CreateSolidBrush(clrBack)
            else
               if (lpdis->itemID mod 2) then
                  clrBack = BGR(255,255,204)   ' light yellow
               else
                  clrBack = BGR(255,255,255)   ' white
               end if
               clrFore = BGR(0,0,0)         ' black
               hBrushBack = CreateSolidBrush(clrBack)
            end if
                     
            ' Paint the entire background
            ' Create our rect that works with the entire line
            SetRect(@rc, 0, 0, nWidth, nHeight)
            FillRect( memDC, @rc, hBrushBack )

            ' Prepare and paint the text coloring
            SetBkColor( memDC, clrBack )   
            SetTextColor( memDC, clrFore )

            ' pad the drawing rectangle to allow left and right margins
            dim as RECT rcText = rc
            rcText.left = rcText.left + AfxScaleX(4)
            rcText.right = rcText.right - AfxScaleX(4)

            dim as long lFormat = DT_SINGLELINE or DT_NOPREFIX
            wszText = AfxGetListBoxText( lpdis->hwndItem, lpdis->itemID )
            DrawText( memDC, wszText, -1, Cast(lpRect, @rcText), lFormat )

            ' Draw a focus rectangle around the item
            If (lpdis->itemState And ODS_SELECTED) Then     
               DrawFocusRect( lpdis->hDC, @lpdis->rcItem )
            end if
                     
            BitBlt lpdis->hDC, lpdis->rcItem.left, lpdis->rcItem.top, _
                   nWidth, nHeight, memDC, 0, 0, SRCCOPY

            ' Cleanup
            If hbit  Then DeleteObject SelectObject(memDC, hbit)
            If memDC Then DeleteDC memDC
            RestoreDC(lpdis->hDC, -1)
            DeleteObject(hBrushBack )
           
            return true
        end if
       
           
      CASE WM_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            CASE IDCANCEL
               ' // If ESC key pressed, close the application by sending an WM_CLOSE message
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         CASE IDC_LISTBOX
            SELECT CASE GET_WM_COMMAND_CMD(wParam, lParam)
               CASE LBN_DBLCLK
                  ' // Get the handle of the Listbox
                  DIM hListBox AS HWND = GetDlgItem(hwnd, IDC_LISTBOX)
                  ' // Get the current selection
                  DIM curSel AS LONG = ListBox_GetCursel(hListBox)
                  ' // Get the length of the ListBox item text
                  DIM nLen AS LONG = ListBox_GetTextLen(hListBox, curSel)
                  ' // Allocate memory for the buffer
                  DIM pwszText AS WSTRING PTR = CAllocate(nLen + 1, 2)
                  ' // Get the text and display it
                  ListBox_GetText(hListBox, curSel, pwszText)
                  MessageBoxW(hwnd, pwszText, "ListBox test", MB_OK)
                  ' // Deallocate the memory used by the buffer
                  DeAllocate pwszText
                  pwszText = NULL

                  ' *** Alternate way using CWSTR ***
'                  DIM cwsText AS CWSTR = ListBox_GetTextLen(hListBox, curSel) + 1
'                  ListBox_GetText(hListBox, curSel, *cwsText)
'                  MessageBoxW(hwnd, cwsText, "ListBox test", MB_OK)

                  EXIT FUNCTION
            END SELECT

         END SELECT

      CASE WM_SIZE
         DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
         IF pScrollWindow THEN pScrollWindow->OnSize(wParam, lParam)
         EXIT FUNCTION

      CASE WM_VSCROLL
         DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
         IF pScrollWindow THEN pScrollWindow->OnVScroll(wParam, lParam)
         EXIT FUNCTION

      CASE WM_HSCROLL
         DIM pScrollWindow AS CScrollWindow PTR = AfxScrollWindowPtr(hwnd)
         IF pScrollWindow THEN pScrollWindow->OnHScroll(wParam, lParam)
         EXIT FUNCTION

      CASE WM_DESTROY
         ' // End the application
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to DefWindowProc
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


[fan42025]

Here is an ownerdrawn listbox with double buffered graphics and alternate line coloring.

Thank you, much appreciated. I was after changing the color of the text for each line, not so much the background but I think I can alter your code to suit my requirements. Again, thank you.