Color MultiLine Header Listview with tooltips

[Chris Chancellor]

Hello All

here is the Listview which comes with Multiline header and tooltips
and also note that its floating statusbar issue has already been fixed

please comment for further improvement

Code Select Expand


'====================================================================
' ColorListView_MH.o2bas
' Color Listview example  modified Nov 10 2018
'  which you can change fonts and color of text and background
' with Multi Line Header and tooltips

'  Uses the latest Dialogs.inc file from
' https://www.oxygenbasic.org/forum/index.php?topic=1525.30
'  message #37         Thanxx to Roland
'====================================================================

$ filename "ColorListView_MH.exe"
use rtl64
#lookahead

' %review

uses O2Common
uses dialogs
uses LVCommon
uses MultiLineHDO2
uses Tooltips

'Identifier for ListView
#define IDC_ListView  2801


'  The program logo icon  is obtained from the resource file
'  the 400 must corespondence to the 400 in the rc file
   #define IDI_LOGO     400


' control ID of statusbar
% IDC_Statusbar  420



' Number of rows in the ListView
   % NumRow = 200
'  Number of columns in the ListView  meaning 3 +1 = 4 columns
   % NumCol = 3   

   

'   Globals
'    For header tooltips array handles
     dim as sys  LVHeaderTTid(NumCol)


   '  Handle for the Main Dialog
     sys hDlg

   ' Fonts handle
     sys  hFont
   
   '  Handle for the ListView
     sys hListview

'    Handle for status bar
    sys hStatus

   '  Row and column number of current cell
     Long CurrentCol, CurrentRow

   ' Handle for the ListView tooltips
    sys  hTTLview

'==========================================
' create and display the Listview
  SUB  DispListView

            int i , j
            string   txtStr

           LV_COLUMN     lvc
           LV_ITEM            lvi
         ' Setup the fonts for the ListView
           SendMessage(hListview,%WM_SETFONT,hFont,0)

  '  Subclass the ListView
     SetProp hListView, "OLDWNDPROC", _
        SetWindowLongPtr(hListView, GWLP_WNDPROC, @ListView_SubclassProc)

   '  Get the handle of the ListView header control and subclass it
   '  sys hLvHeader
    hLvHeader = ListView_GetHeader(hListView)
     IF hLvHeader = 0 THEN
         EXIT FUNCTION
      end if
 
     IF hLvHeader THEN
         SetProp hLvHeader, "OLDWNDPROC", _
         SetWindowLongPtr(hLvHeader, GWLP_WNDPROC, @LVHeader_SubclassProc)
      END IF       


        'Setup the  ListView Column Headers
      '        The  first column must have a wider width to accomodate the checkbox
               lvc.mask =    LVCF_WIDTH  or  LVCF_ORDER
           '    Need to add some blanks behind the header string label
         '    inorder to get a wider column
               txtStr="Column #" & str(1) +  "      " +cr + "( characters )"
              lvc.pszText = txtStr   
              lvc.iorder = 0     
              ListView_InsertColumn(hListview, 0, &lvc)

     '   All the other columns to have a narrower width
        For i = 1  To  NumCol 
              lvc.mask = LVCF_FMT OR   LVCF_WIDTH   OR  LVCF_TEXT  OR LVCF_SUBITEM
            If  i =  NumCol then
                   '   Leave the last column header blank as we are NOT putting data
                  '   into this last column ( it act like a buffer )
                      txtStr = ""
            Elseif i = 1
                  txtStr="Column #" & str(i+1) + cr + "( numbers )"
                  txtStr =  Trim(txtStr)
           Elseif i = 2
                  txtStr="Column #" & str(i+1) + cr + "( alphanumeric )"
                  txtStr =  Trim(txtStr)
           End if
               lvc.pszText =  txtStr   
               lvc.iorder = i 
                ListView_InsertColumn(hListview, i, &lvc)
        Next i

 
        ' Setup the Listview  data Rows
        For i=1 To NumRow
              'First column
              lvi.mask      =  LVIF_TEXT
              txtStr = "Row #" & str(200-i+1) ", Col # 1"
             lvi.pszText   = txtStr
             lvi.iSubItem  =  0
             ListView_InsertItem(hListview, &lvi)

           'Remaining columns
           for j=2 to NumCol
                 txtStr = "Row #" & str(200-i+1) ", Col # " & str(j)
                lvi.pszText   = txtStr
                lvi.iSubItem  =  j-1
                ListView_SetItem(hListview, &lvi)
           next j
        Next i

   '   Set the column widths according to width of  each column header
       for i = 0 to NumCol -1
              ListView_SetColumnWidth(hListview,i,LVSCW_AUTOSIZE_USEHEADER)
        next i
   '  make the last column a very narrow width as it is only a buffer column
   '  this would display as a double line
       ListView_SetColumnWidth(hListview,NumCol,3)
 

  '    Place in the extended style for the listview
        SendMessage(hListview, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, 
                       LVS_EX_FULLROWSELECT or LVS_EX_CHECKBOXES or LVS_EX_GRIDLINES )



    '  Shade  ListView background to Alice Blue
'     while the text color is Navy
          SendMessage(hListView, LVM_SETTEXTCOLOR, 0,RGB(0,0,128))
          SendMessage(hListView, LVM_SETBKCOLOR, 0,RGB(240,248,255))
     

END SUB


'======================================
' Setup the tooltips for the listview   headers
SUB GetToolTipsLVH(hDlgTT AS DWORD)

  'For all listview columns header tooltips
   LOCAL  idxx       AS  Long
   LOCAL  LVColRect  AS RECT   
   LOCAL  HdHelpst AS WSTRING
   
 
    hLvHeader = ListView_GetHeader(hListview)
    'Get listview header column rectangle
    FOR idxx = 1 TO NumCol
                    SendMessage(hLVHeader, HDM_GETITEMRECT, _
                                        idxx -1, VARPTR(LVColRect))
       

        'Set tooltip strings
        'Setup the tooltip help strings
         SELECT CASE idxx
                CASE 1
                          HdHelpst ="Enter characters only "

                CASE 2
                          HdHelpst = "Enter numbers only"

                CASE 3
                          HdHelpst = "Enter alphanumerics only"
         
            END SELECT
   
            LVHeaderTTid(idxx) = SetToolTipsPArea(hLVHeader, _
                                  LVColRect ,  HdHelpst )
     
    NEXT  idxx
   

END SUB


'====================================================================
'   Main callback function
    Function DlgProc( hDlg, uint uMsg, sys wParam, lParam ) as sys callback

     '  Obtain the handle for the ListView
      hListview = GetDlgItem(hDlg, IDC_ListView) 


      POINT wpt
      RECT  wrc
      LOCAL  LVColRect  AS RECT
      Local lplvcd As NMLVCUSTOMDRAW Ptr


  SELECT CASE uMsg


     CASE  WM_INITDIALOG
      ' display the program icon
            sys  hInstance = GetModuleHandle(NULL)
            sys hIcon = LoadIcon(hInstance, IDI_Logo)
           'Set Icon to Main Window
            SendMessage(hDlg, WM_SETICON, ICON_BIG, hIcon)

          ' Create and display the listview
            DispListView
   
       
        '  Set timer to redraw statusbar within  0.1 secs at the start and for one time only
         '  otherwise the statusbar will NOT be display upon starting the program
            SetTimer hDlg, 1, 100,  NULL
 
'           Setup the tooltips
             GetToolTipsLVH hDlg
              hTTLview=SetToolTip(hListview, "Table of information", true)

           ' Tooltips for the close button 
            LOCAL rtc AS RECT
             GetClientRect(hDlg, rtc)
             rtc.Right  = rtc.Right - 3
             rtc.Left   = rtc.Right - GetSystemMetrics(SM_CYCAPTION)- 2
             rtc.Bottom = -3
              rtc.Top    = 3 - GetSystemMetrics(SM_CYCAPTION)
              SetToolTipsPArea(hDlg, rtc,  " Close and Exit the program ") 



    CASE  WM_TIMER
             ' Redraw the statusbar  after which, we kill off the timer
            '  as this is a ONE time affair
              BlankStatusBar(hDlg)
              KillTimer hDlg, 1



    CASE  WM_COMMAND
          SELECT CASE LOword(wParam)
                     CASE IDCANCEL   
         '            exit   
                     KillTimer hDlg, 1
                     DeleteObject(hFont)
                     DestroyWindow( hDlg )
          END SELECT



    CASE  WM_NOTIFY
              NMHDR pnm at lParam

              IF pnm.hwndFrom = hListview then
                           'ListView   
                           NM_LISTVIEW LpLvNm at lParam

                   SELECT CASE pnm.code
                        CASE  LVN_COLUMNCLICK
                                   CurrentCol = LpLvNm.iSubItem + 1
                                    mbox "Header clicked at column  "    + str(CurrentCol)
                       
                        CASE  LVN_ITEMCHANGED
                                  'turn off entire row selection here
                                ' https://forum.powerbasic.com/forum/user-to-user-discussions/programming/774914-add-checkbox-into-a-virtual-listview?p=775009#post775009
                                  ' ListView_SetItemState hListView, LpLvNm.iItem, 0, LVIS_Focused Or LVIS_Selected

   



                        CASE NM_CLICK     ' click on a cell
                             '     printl " click "
                                   BlankStatusBar(hDlg)
                                 NM_LISTVIEW LpLvNm at (lParam)
                                CurrentRow = LpLvNm.iiTem + 1
                                CurrentCol = LpLvNm.iSubItem + 1
                                UpdateStatusBar(hDlg)

                   END SELECT
            END IF
 

           





      CASE  WM_SIZE 
           '   Entire client window size  for the listview 
               RECT rcClient
              GetClientRect(hListview, &rcClient)
 
        '     obtain the statusbar position
            'get window rect of control relative to screen
             GetWindowRect(hstatus, &wrc)

           ' move bottom of work area of listview up one statusbar height
             rcClient.Bottom    = rcClient.Bottom - (wrc.Bottom - wrc.Top)
             SetWindowPos(hListview, NULL, 0, rcClient.top, rcClient.right, rcClient.bottom, SWP_NOZORDER)
            UpdateStatusBar(hDlg)



 
      CASE %WM_ERASEBKGND   
'            added to display background color for the main window 
             hBGDC = wParam
  '          Pass the DC of the region to be repaint
             DrawGradient hBGDC           
             FUNCTION = 1
             EXIT FUNCTION



   CASE  WM_SIZING
             Exit Function
            '  BlankStatusBar(hDlg)
            '  UpdateStatusBar(hDlg)

   CASE  WM_MOVING
              BlankStatusBar(hDlg)
              UpdateStatusBar(hDlg)

   CASE  WM_MOVE
              BlankStatusBar(hDlg)
              UpdateStatusBar(hDlg)

    case WM_CLOSE
              KillTimer hDlg, 1
              DestroyWindow( hDlg )

    case WM_DESTROY
              KillTimer hDlg, 1
              PostQuitMessage( null )

  end select

  return 0
end function


'=====================
' The status bar displaying the current position of cursor
' and help text for each column
SUB UpdateStatusBar(sys hWnd)
    IF CurrentRow <= 0 THEN
        BlankStatusBar(hDlg)
        exit sub
   End If
   hStatus=GetDlgItem(hWnd, IDC_Statusbar)
   SendMessage(hStatus, SB_SETTEXT, 0, "Row " & str(CurrentRow) & "  :  " & "Col " & str(CurrentCol))

' Help text for each column when a particular column is clicked
   SELECT CASE CurrentCol
       CASE 1
            SendMessage(hStatus, SB_SETTEXT, 1, "Enter characters only")
       CASE 2
            SendMessage(hStatus, SB_SETTEXT, 1, "Enter numbers only")
       CASE 3
            SendMessage(hStatus, SB_SETTEXT, 1, "Enter Alphanumeric here")
   END SELECT
END SUB


'=====================
' Blank out the status bar
SUB BlankStatusBar(sys hWnd)
    hStatus=GetDlgItem(hWnd, IDC_Statusbar)
    SendMessage(hStatus, SB_SETTEXT, 0, "                                ")
    SendMessage(hStatus, SB_SETTEXT, 1, "                                ")
END SUB



'====================================================================
'  Display the Main Dialog
Function  DispMainDialog
     
         MSG wMsg

     '  for a light yellow background
        MainWindBGColor = 1

       '  or WS_THICKFRAME  WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN

    '  Place a fixed border (non changeable size dialog)
     Dialog(  10,10,310,250, "MultiLine Header Listview with Tooltips     ",
                   WS_BORDER or DS_CENTER or WS_VISIBLE or  WS_SYSMENU,
                                    8,"MS Sans Serif" )

    '   Add in the listview -- ensure that it is smaller size than the dialog
        CONTROL "",IDC_ListView,"SysListView32", _
           WS_VISIBLE   or  WS_TABSTOP   or   LVS_REPORT  or  LVS_SINGLESEL or  LVS_EX_DOUBLEBUFFER , _
                             10,10,305,225,   WS_EX_CLIENTEDGE
     
  '  Create the font
     hFont = O2ApiCreateFont("Arial",9, FW_Bold)

   ' Create the Dialog
     hDlg = CreateModelessDialog( null, @DlgProc, 0 )


   ' Add in the statusbar
   hStatus = CreateStatusWindow(WS_CHILD | WS_BORDER | WS_VISIBLE | SBS_SIZEGRIP | CCS_BOTTOM, "", hDlg, IDC_Statusbar)

    'Statusbar set parts
    int statwidths[] = {100, -1}
    SendMessage(hStatus, SB_SETPARTS, 2, &statwidths)
    SendMessage(hStatus, SB_SETTEXT, 0, "Row : Col")
    UpdateStatusBar(hDlg)

   


       while GetMessage( @wMsg, null, 0, 0 ) <> 0
              if IsDialogMessage( hDlg,  @wMsg ) = 0 then
                            TranslateMessage( @wMsg )
                            DispatchMessage( @wMsg )
               end if
          wend
End Function



'------------------------------------
'  Start of program
   init_common_controls()
   DispMainDialog






[Karen Zibowski]

Chris,

Many thanks, this is a splendid code!!!       

[Chris Chancellor]

you are most welcome Karen
i luv O2 as this is the most flexible programming language