• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

Example Multiline Header Listview

Started by Chris Chancellor, November 10, 2018, 06:20:49 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Chris Chancellor

Hello All

Thanxx to Charles, Jose and Roland for their help and contributions in building up this code

this example code display a listview with a multiline header

the attached zip file contains all the stuff you needed for this program


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

'  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
uses O2Common
uses dialogs



'Identifier for ListView
#define IDC_LSV1  3801


'  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
   % ICON_BIG=1
   % WM_SETICON=0x80

' control ID of statusbar
% IDC_Statusbar  420




macro ListView_InsertColumn(hwnd,iCol,pcol) (SendMessage(hwnd, LVM_INSERTCOLUMN, iCol, pcol))
macro ListView_SetColumnWidth(hwnd,iCol,cx) (SendMessage(hwnd, LVM_SETCOLUMNWIDTH, iCol, cx))
macro ListView_InsertItem(hwnd,pitem) (SendMessage(hwnd, LVM_INSERTITEM,0, pitem))
macro ListView_SetItem(hwnd,pitem) (SendMessage(hwnd, LVM_SETITEM,0, pitem))





% LVS_LIST  0x0003
% LVS_REPORT  0x0001
% LVS_EX_GRIDLINES 1
% LVS_EX_CHECKBOXES 4
% LVS_EX_FULLROWSELECT  0x0020

%  LVS_SINGLESEL = 0x0004
%  LVS_EX_DOUBLEBUFFER = 0x0010000

'% LVSCW_AUTOSIZE  dword -1
'% LVSCW_AUTOSIZE_USEHEADER dword -2
% LVSCW_AUTOSIZE   -1
% LVSCW_AUTOSIZE_USEHEADER  -2


% LVCF_FMT 1
% LVCF_WIDTH 2
% LVCF_TEXT=4
% LVCF_SUBITEM 8
% LVCF_ORDER = 20
% LVIF_TEXT=1
% LVM_SETEXTENDEDLISTVIEWSTYLE 0x1036
% LVN_COLUMNCLICK = -108
% LVN_ITEMCHANGED = -101
% NM_CLICK  -2

% LR_LOADFROMFILE=0x0010
% IMAGE_ICON=1
% STM_SETIMAGE=0x172
% SWP_NOZORDER=4

' Statusbar
% SB_SETPARTS 0x404
% SB_SETTEXT 0x401
% SBS_SIZEGRIP 16
% CCS_BOTTOM 3



' ListView messages
%  LVM_FIRST = &H1000
%  LVM_SETBKCOLOR = LVM_FIRST + 1
%  LVM_SETTEXTCOLOR       = LVM_FIRST + 36
%  LVM_GETHEADER          =  LVM_FIRST + 31

% LVM_INSERTCOLUMN=  LVM_FIRST + 27
% LVM_SETCOLUMNWIDTH=LVM_FIRST + 30
% LVM_INSERTITEM=%LVM_FIRST + 7
% LVM_SETITEM=LVM_FIRST + 6


type LVCOLUMN
  uint  mask
  int   fmt
  int   cx
  char* pszText
  int   cchTextMax
  int   iSubItem
  int   iImage
  int   iOrder
  int   cxMin
  int   cxDefault
  int   cxIdeal 
end type
typedef LVCOLUMN LV_COLUMN

type LVITEM 
  uint   mask
  int    iItem
  int    iSubItem
  uint   state
  uint   stateMask
  char*  pszText
  int    cchTextMax
  int    iImage       // index of the list view item's icon
  sys    lParam       // 32-bit value to associate with item
  int    iIndent
  int    iGroupId
  uint   cColumns
  uint   *puColumns
  int    *piColFmt
  int    iGroup
end type

typedef LVITEM LV_ITEM


type NMLISTVIEW
  NMHDR hdr
  int   iItem
  int   iSubItem
  uint  uNewState
  uint  uOldState
  uint  uChanged
  POINT ptAction
  sys   lParam
end type

typedef NMLISTVIEW NM_LISTVIEW


uses MultiLineHDO2



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



'   Globals
   '  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



'==========================================
' 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 those unused background portions of the main ListView 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





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

 
  '  Obtain the handle for the ListView
     hListview = GetDlgItem(hDlg, IDC_LSV1) 
   
      POINT wpt
      RECT  wrc

  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

   

    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

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

                   END SELECT
            END IF
 

      CASE  WM_SIZE     
               RECT rcClient
       '  // Calculate remaining height and size edit
              GetClientRect(hDlg, &rcClient)
              SetWindowPos(hListview, NULL, 0, rcClient.top, rcClient.right, rcClient.bottom, SWP_NOZORDER)

        '    move the statusbar
             hstatus = GetDlgItem(hDlg, IDC_statusbar)
             'get window rect of control relative to screen
             GetWindowRect(hstatus, &wrc)
             'new point object using rect x, y
              wpt = { wrc.left, wrc.top }
            'convert screen co-ords to client based points
             ScreenToClient(hDlg, &wpt)

            'example if  wanted to move the  said control
             'wrc.right - wrc.left, wrc.bottom - wrc.top to keep control at its current size
         '   MoveWindow(hstatus, wpt.x, wpt.y + 15, wrc.right - wrc.left, wrc.bottom - wrc.top, TRUE)
           long hhs
          hhs = wrc.top - wrc.bottom
          MoveWindow hListView, 0, 0, LOWORD( LPARAM), HIWORD(LPARAM) - hhs, TRUE
          UpdateStatusBar(hDlg)

   CASE  WM_SIZING
              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


     Dialog(  10,10,300,200, "Listview example 64bits ",
                  WS_OVERLAPPEDWINDOW or DS_CENTER or WS_VISIBLE or WS_CLIPCHILDREN or WS_THICKFRAME,
                                    8,"MS Sans Serif" )

    '   Add in the listview or  WS_BORDER
        CONTROL "",IDC_LSV1,"SysListView32", _
           WS_VISIBLE   or  WS_TABSTOP   or   LVS_REPORT  or  LVS_SINGLESEL or  LVS_EX_DOUBLEBUFFER , _
                             10,10,275,50,   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





Chris Chancellor


note that there is a defect in this code --- its statusbar floats upwards during scrolling of the listview

if you can resolve this, please help by improving on this code and submit these modifications
Thanxx