Listview

BlitzMax Forums/BlitzMax Programming/Listview
Henri
(Posted 2017) [#1]
Hi,

have you ever wanted to create multicolumn listbox (also known as listview which is a native Windows control) with alternating colours ?

Like this:
Strict

Import maxgui.drivers

Extern "win32"
	Function GetModuleHandle:Int (lpmodulehandlename:Byte Ptr)="GetModuleHandleW@4"
	Function CreateWindowEx:Int (dwExstyle:Int,lpclassname:Short Ptr,lpwindowname:Short Ptr,dwStyle:Int,x:Int,y:Int,..
								w:Int,h:Int,hwndparent:Int,hmenu:Int,hinstance:Int,lpparam:Int)="CreateWindowExW@48"
End Extern

Const LVM_GETITEM = (LVM_FIRST + 75)
Const LVM_SETITEM = (LVM_FIRST + 76)
Const LVM_INSERTITEMW = (LVM_FIRST + 77)
Const LVM_INSERTITEM = LVM_INSERTITEMW
Const LVM_FINDITEMW = (LVM_FIRST + 83)
Const LVM_FINDITEM = LVM_FINDITEMW
Const LVM_GETSTRINGWIDTHW = (LVM_FIRST + 87)
Const LVM_GETSTRINGWIDTH = LVM_GETSTRINGWIDTHW
Const LVM_EDITLABELW = (LVM_FIRST + 118)
Const LVM_EDITLABEL = LVM_EDITLABELW
Const LVM_GETCOLUMNW = (LVM_FIRST + 95)
Const LVM_GETCOLUMN = LVM_GETCOLUMNW
Const LVM_SETCOLUMNW = (LVM_FIRST + 96)
Const LVM_SETCOLUMN = LVM_SETCOLUMNW
Const LVM_INSERTCOLUMNW = (LVM_FIRST + 97)
Const LVM_INSERTCOLUMN = LVM_INSERTCOLUMNW
Const LVM_GETITEMTEXTW = (LVM_FIRST + 115)
Const LVM_GETITEMTEXT = LVM_GETITEMTEXTW
Const LVM_SETITEMTEXTW = (LVM_FIRST + 116)
Const LVM_SETITEMTEXT = LVM_SETITEMTEXTW
Const LVM_GETISEARCHSTRINGW = (LVM_FIRST + 117)
Const LVM_GETISEARCHSTRING = LVM_GETISEARCHSTRINGW
Const LVM_GETBKIMAGEW = (LVM_FIRST + 139)  'IE 4 and later
Const LVM_SETBKIMAGEW = (LVM_FIRST + 138)  'IE 4 and later
'Const LVBKIMAGE = LVBKIMAGEW               'IE 4 and later
'Const LPLVBKIMAGE = LPLVBKIMAGEW           'IE 4 and later
Const LVM_SETBKIMAGE = LVM_SETBKIMAGEW     'IE 4 and later
Const LVM_GETBKIMAGE = LVM_GETBKIMAGEW     'IE 4 and later

Const CDRF_DODEFAULT = $00000000
Const CDRF_NEWFONT = $00000002
Const CDRF_SKIPDEFAULT = $00000004
Const CDRF_NOTIFYPOSTPAINT = $00000010
Const CDRF_NOTIFYITEMDRAW = $00000020
Const CDRF_NOTIFYSUBITEMDRAW = $00000020
Const CDRF_NOTIFYPOSTERASE = $00000040

Const CDDS_PREPAINT = $00000001
Const CDDS_POSTPAINT = $00000002
Const CDDS_PREERASE = $00000003
Const CDDS_POSTERASE = $00000004
Const CDDS_ITEM = $00010000
Const CDDS_ITEMPREPAINT = (CDDS_ITEM|CDDS_PREPAINT)
Const CDDS_ITEMPOSTPAINT = (CDDS_ITEM|CDDS_POSTPAINT)
Const CDDS_ITEMPREERASE = (CDDS_ITEM|CDDS_PREERASE)
Const CDDS_ITEMPOSTERASE = (CDDS_ITEM|CDDS_POSTERASE)
Const CDDS_SUBITEM = $00020000
Const WC_LISTVIEW:String			= "SysListview32"

'EXAMPLE
'------------------------------------------------------------------------------------
Local win:tgadget = CreateWindow("test", 0, 0, 310, 300, Null, WINDOW_DEFAULT)
Local lv:TListview = TListview.Create(20, 20, 200, 200, win)
lv.addColumns(["Name","Value"])
lv.addItems(["item 0","item1"])
lv.addItems(["item 1","item1"])
lv.addItems(["item 2","item1"])
lv.addItems(["item 3","item1"])
lv.addItems(["item 4","item1"])
lv.addItems(["item 5","item1"])
lv.addItems(["item 6","item1"])
lv.addItems(["item 7","item1"])
lv.addItems(["item 8","item1"])
lv.addItems(["item 9","item1"])
lv.addItems(["item 10","item1"])
lv.addItems(["item 11","item1"])
lv.addItems(["item 12","item1"])

Repeat
	WaitEvent()
	Select EventID()
	Case EVENT_WINDOWCLOSE		End
	Case EVENT_GADGETACTION		
	EndSelect
Forever
'------------------------------------------------------------------------------------

Const BORDER_NONE:Int = 0
Const BORDER_3D:Int = 1
Const BORDER_THIN:Int = 2

Type TListview
	Field hwnd:Int, lv_hwnd:Int
	Field gadget:tgadget
	Global oldWndProc:Byte Ptr	'(hwnd,msg,wparam,lparam) "win32"
	Global list:TList
	
	Function Create:TListview(x:Int, y:Int, width:Int, height:Int, group:tgadget)
		Local lv:TListview = New TListview
		lv.gadget = CreatePanel(x,y,width,height,group)
		lv.hwnd = QueryGadget(lv.gadget,QUERY_HWND)
		lv.setListviewBorder(BORDER_3D)
		SetGadgetLayout(lv.gadget,1,0,1,0)
		
		Local wstyle:Int =  WS_CHILD | WS_VISIBLE| LVS_REPORT | LVS_EDITLABELS
		lv.lv_hwnd = CreateWindowEx(0,WC_LISTVIEW,"",wstyle,0,0,ClientWidth(lv.gadget),ClientHeight(lv.gadget),..
										lv.hwnd,Null,GetModuleHandle(Null),Null)
										
		SendMessageW(lv.lv_hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, LVS_EX_FULLROWSELECT)
		TListview.oldWndProc = Byte Ptr(SetWindowLongW(lv.hwnd, GWL_WNDPROC, Int Byte Ptr _WndProc))
		
		If Not TListview.list Then TListview.list = New TList
		TListview.list.addlast(lv)
		
		Return lv
	End Function
	
	Function _WndProc(hwnd:Int, msg:Int, wparam:Int, lparam:Int)
		Local nmhdr:Int Ptr

		Select msg
		
		Case WM_NOTIFY
			nmhdr = Int Ptr lparam
			Select nmhdr[2]
			
			Case NM_CUSTOMDRAW						
				Local lv:TListview = ListviewFromHwnd(hwnd)
				Local result:Int
				If lv	
					result = ProcessCustomDraw(lparam)
					Return result
				EndIf
			EndSelect
		
		EndSelect
		
		If oldWndProc Then Return CallWindowProcW(oldWndProc, hwnd, msg, wparam, lparam)
	EndFunction

	Function ProcessCustomDraw:Int(lparam:Int)
	
		Local nmcd:Int Ptr = Int Ptr lParam
		Local cd:_NMLVCUSTOMDRAW = New _NMLVCUSTOMDRAW
		MemCopy(cd, Byte Ptr lParam, SizeOf(_NMLVCUSTOMDRAW ))

		Local i:Int = cd.dwItemSpec	'.dwItemSpec
    	
		Select cd.dwDrawStage 	'.dwDrawStage 

		Case CDDS_PREPAINT	'Before the paint cycle begins
		    'request notifications For individual listview items
			Return CDRF_NOTIFYITEMDRAW
		    
		Case CDDS_ITEMPREPAINT	'Before an item is drawn
			If (i Mod 2) = 0
				'customize item appearance
				nmcd[12] = $ff1111 'clrText
				nmcd[13] = $eeeeee 'clrTextBk
		        Return CDRF_NEWFONT
		    Else
				nmcd[12] = $2222ff 'clrText
				nmcd[13] = $ffffff 'clrTextBk
		    
		        Return CDRF_NEWFONT
		    EndIf

        'Before a subitem is drawn
		Case CDDS_SUBITEM | CDDS_ITEMPREPAINT	'|
			If i=1
				If cd.iSubItem = 0	'.iSubItem=0
					'customize subitem appearance For column 0
					'nmcd[12] = $ff1111 'RGB(255,0,0); ..clrText
					'nmcd[13] = $aaaaaa 'RGB(255,255,255); .clrTextBk
					
					'To set a custom font:
					'SelectObject(lplvcd->nmcd.hdc, 
					'    <your custom HFONT>);
				
					Return CDRF_NEWFONT
				Else If cd.iSubItem = 1		'iSubItem = 1
					'customize subitem appearance For columns 1..n
					'Note: setting For column i 
					'carries over To columnn i+1 unless
					'      it is explicitly reset
					'nmcd[12] = $aaaaaa 'RGB(255,0,0); clrText
					'nmcd[13] = $123456 'RGB(255,255,255);clrTextBk 
					
					Return CDRF_NEWFONT
				EndIf
			EndIf
     	EndSelect

    	Return CDRF_DODEFAULT
	EndFunction
	
	Method setListviewBorder(bordertype:Int)
	
		Local exstyle:Int = GetWindowLongW(hwnd, GWL_EXSTYLE)	
	
		Select bordertype
			Case BORDER_NONE
				If exstyle & WS_EX_CLIENTEDGE Then SetWindowLongW( hwnd, GWL_EXSTYLE, exstyle & ~WS_EX_CLIENTEDGE)
			Case BORDER_THIN
				If exstyle & WS_EX_CLIENTEDGE Then SetWindowLongW( hwnd, GWL_EXSTYLE, exstyle & ~WS_EX_CLIENTEDGE)		
			Case BORDER_3D
				If Not (exstyle & WS_EX_CLIENTEDGE) Then SetWindowLongW( hwnd, GWL_EXSTYLE, exstyle | WS_EX_CLIENTEDGE)			
		EndSelect
		
		SetWindowPos( hwnd,0, 0,0,0,0, SWP_NOMOVE | SWP_NOSIZE | SWP_NOZORDER | SWP_NOACTIVATE | SWP_FRAMECHANGED)
	EndMethod
	
	Method setStyle(style:Int)
		'Local dwStyle:Int = GetWindowLongW(lv_hwnd, GWL_STYLE) 
		'dwStyle
	    'SetWindowLongW(lv_hwnd, GWL_STYLE,
	     '             (dwStyle & ~LVS_TYPEMASK) | dwView);
	
	EndMethod
	
	Method activate()
		SetFocus(lv_hwnd)
	EndMethod
	
	Method addColumns:Int(lvcols:String[])
		Local lvc:_LVCOLUMN = New _LVCOLUMN
		Local iCol:Int
		
		lvc.mask = LVCF_FMT | LVCF_WIDTH | LVCF_TEXT | LVCF_SUBITEM

		For iCol = 0 Until lvcols.length
			lvc.pszText = lvcols[iCol].ToWString()
			lvc.iSubItem = iCol
			lvc.cchTextMax = lvcols[iCol].length
			
			lvc.cx = 100				'Width of column in pixels.
			
			If iCol < 2
				lvc.fmt = LVCFMT_LEFT	'Left-aligned column.
			Else
			    lvc.fmt = LVCFMT_RIGHT	'Right-aligned column.
			EndIf
		
		    'Insert the columns into the list view.
		 	If SendMessageW(lv_hwnd, LVM_INSERTCOLUMN, iCol, Int(Byte Ptr lvc))=-1
				MemFree lvc.pszText
				Return False
			EndIf
			MemFree lvc.pszText
		Next
		Return True
	EndMethod
	
	Method addItems:Int(items:String[])
		Local itemCount:Int = SendMessageW(lv_hwnd, LVM_GETITEMCOUNT, 0, 0)
		Local lvItem:_LVITEM = New _LVITEM
		lvItem.mask=LVIF_TEXT					' Text Style
		lvItem.cchTextMax = 256					' Max size of text
		lvItem.iItem = itemCount				' choose item  
		lvItem.iSubItem = 0						' Put in First coluom
		lvItem.pszText = items[0].ToWString()	' Text To display (can be from a char variable) (Items)
		
		SendMessageW(lv_hwnd, LVM_INSERTITEM, 0, Int(Byte Ptr lvItem))
		
		For Local iCol:Int = 1 Until items.length ' Add SubItems in a loop
			lvItem.iSubItem = iCol
			lvItem.pszText = items[iCol].ToWString()
			SendMessageW(lv_hwnd, LVM_SETITEM, 0, Int(Byte Ptr lvItem)) ' Enter text To SubItems
			MemFree lvItem.pszText
		Next
	EndMethod
	
	Method clearItems()
		SendMessageW(lv_hwnd,LVM_DELETEALLITEMS,0,0)
	EndMethod
	
EndType

Function ListviewFromHwnd:TListview(hwnd:Int)
	If TListview.list
		For Local lv:TListview = EachIn TListview.list
			If lv.lv_hwnd=hwnd Or lv.hwnd=hwnd Return lv
		Next
	EndIf
	
	Return Null
EndFunction

Type _LVCOLUMN
	Field mask:Int
	Field fmt:Int
	Field cx:Int
	Field pszText:Short Ptr
	Field cchTextMax:Int
	Field iSubItem:Int
	'#If (_WIN32_IE >= 0x0300)
	Field iImage:Int
	Field iOrder:Int
	'#EndIf 
	'#If (_WIN32_WINNT >= 0x0600)
	Field cxMin:Int
	Field cxDefault:Int
	Field cxIdeal:Int
	'#EndIf 
EndType

Type _LVITEM
	Field mask:Int
	Field iItem:Int
	Field iSubItem:Int
	Field state:Int
	Field stateMask:Int
	Field pszText:Short Ptr	'LPTSTR
	Field cchTextMax:Int
	Field iImage:Int
	Field lParam:Int	'LPARAM
	'#If (_WIN32_IE >= 0x0300)
	Field iIndent:Int
	'#EndIf 
	'#If (_WIN32_WINNT >= 0x0501)
	Field iGroupId:Int
	Field cColumns:Int
	Field puColumns:Int
	'#EndIf 
	'#If (_WIN32_WINNT >= 0x0600)
	Field piColFmt:Int
	Field iGroup:Int
	'#EndIf 
EndType

Type _NMLVCUSTOMDRAW
	Field hwndFrom:Int Ptr
	Field idFrom:Int Ptr
	Field code:Int
	'Field hdr:Int Ptr
	Field dwDrawStage:Int
	Field hdc:Int Ptr	'HDC
	'Field rc:Int Ptr	'_RECT
	Field rleft:Int	' = LVIR_BOUNDS
	Field rtop:Int
	Field rright:Int
	Field rbottom:Int

	Field dwItemSpec:Int 'Ptr
	Field uItemState:Int
	Field lItemlParam:Int	'LPARAM
	
	Field clrText:Int	'COLORREF
	Field clrTextBk:Int	'COLORREF
	Field iSubItem:Int
	Field dwItemType:Int
	Field clrFace:Int	'COLORREF
	Field iIconEffect:Int
	Field iIconPhase:Int
	Field iPartId:Int
	Field iStateId:Int
	Field rcText:Int Ptr	'_RECT
	Field uAlign:Int   
EndType
This is just a proof of consept, but if somebody wants, I can create more serious effort. wxWidgets already does this internally in it's Windows implemention, but there are benefits in a standalone version.

-Henri