$include "windowssdk.inc" openconsole 'for subclassing the listview control def hLV as UINT def origfp as UINT 'for subclassing the header control of the listview def hHC as UINT def origfpHC as UINT 'DECLARES from the Windows API we will use in our program 'DECLARE IMPORT,CallWindowProcA(lpPrevWndFunc:int,hWnd:int,Msg:int,wParam:int,lParam:int),int 'DECLARE IMPORT,SetWindowLongA(hWnd:int,nIndex:int,dwNewLong:int),int 'DECLARE IMPORT,GetWindowLongA(hWnd:int,nIndex:int),int 'DECLARE IMPORT,GetDlgItem(hDlg:int,nIDDlgItem:int),int 'DECLARE IMPORT,SetBkColor(hdc as UINT,cBack as UINT),UINT 'DECLARE IMPORT,SetTextColor(hdc as UINT,crColor as UINT),INT 'Necessary constants CONST GWL_WNDPROC=-4 CONST HDN_FIRST = (-300) CONST HDN_BEGINTRACKA = (HDN_FIRST-6) CONST HDN_BEGINTRACKW = (HDN_FIRST-26) CONST WM_NOTIFY = 0x4E CONST WM_SETCURSOR = 0x20 CONST NM_CUSTOMDRAW = (-12) CONST CDDS_PREPAINT = 1 CONST CDDS_ITEM = 0x10000 CONST CDDS_SUBITEM = 0x20000 CONST CDDS_ITEMPREPAINT = (CDDS_ITEM | CDDS_PREPAINT) CONST CDDS_SUBITEMPREPAINT = (CDDS_SUBITEM | CDDS_ITEMPREPAINT) CONST CDRF_NOTIFYITEMDRAW = 0x20 CONST CDRF_NOTIFYSUBITEMDRAW = 0x20 CONST CDRF_DODEFAULT = 0 CONST CDRF_NEWFONT = 2 CONST DWL_MSGRESULT = 0 CONST LVM_FIRST = 0x1000 CONST LVM_SETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 54) CONST LVS_EX_FULLROWSELECT = 0x20 CONST LVS_EX_GRIDLINES = 1 CONST LVS_EX_FLATSB = 0x100 CONST LVS_EX_LABELTIP = 0x4000 def d1 as Dialog 'standard NMLISTVIEW UDT 'Windows sends a variable of this type in @LPARAM 'during a notification message. TYPE NMLISTVIEW def hwndFrom:UINT def idFrom:INT def code:INT def iItem:INT def iSubItem:INT def uNewState:UINT def uOldState:UINT def uChanged:UINT def ptActionx:INT def ptActiony:INT def lParam:INT ENDTYPE 'type for handling custom drawing of the header control TYPE NMCUSTOMDRAWINFO NMHDR hdr UINT dwDrawStage UINT hdc WINRECT rc UINT dwItemSpec UINT uItemState UINT lItemlParam ENDTYPE 'type for handling custom drawing of the list view control TYPE NMLVCUSTOMDRAW NMCUSTOMDRAWINFO nmcd UINT clrText UINT clrTextBk 'if internet explore version >= 4.0 int iSubItem ENDTYPE type LVCOLUMN UINT mask int fmt int cx string pszText int cchTextMax int iSubItem int iOrder int iImage endtype LVCOLUMN lvc CONST LVCF_TEXT = &H4 CONST LVCF_SUBITEM = &H8 CONST LVCF_ORDER = &H20 CONST LVM_FIRST = &H1000 CONST LVM_GETCOLUMNA = (LVM_FIRST + 25) 'variable indicating whether columns are resizeable or not bLocked = 1 'create the dialog and add the controls CREATEDIALOG d1,0,0,295,168,0x80C80080,0,"Advanced List view demo",&handler CONTROL d1,@LISTVIEW,"",27,10,240,110,@LVSREPORT|@BORDER|@LVSSHOWSELALWAYS,100 CONTROL d1,@CHECKBOX,"Lock column resize",27,125,240,20,0,300 CONTROL d1,@STATIC,"Click on column headers",27,150,240,20,0,200 'show the dialog and wait for it to close domodal d1 closeconsole 'end program end 'the message handler for the dialog SUB handler select @MESSAGE case @IDINITDIALOG centerwindow d1 'insert columns and some items 'after an item is inserted we use @LVSETTEXT to 'change the subitems text CONTROLCMD d1,100,@LVINSERTCOLUMN,0,"Column1" CONTROLCMD d1,100,@LVINSERTCOLUMN,1,"Column2" CONTROLCMD d1,100,@LVINSERTCOLUMN,2,"Column3" CONTROLCMD d1,100,@LVINSERTCOLUMN,3,"Column4" 'the first columns item and sub items ?CONTROLCMD(d1,100, @LVGETCOUNT) CONTROLCMD d1,100,@LVINSERTITEM,0,"Item 1" CONTROLCMD d1,100,@LVSETTEXT,0,1,"Sub 1a" CONTROLCMD d1,100,@LVSETTEXT,0,2,"Sub 2a" ?CONTROLCMD(d1,100, @LVGETCOUNT) 'the second column CONTROLCMD d1,100,@LVINSERTITEM,1,"Item 2" CONTROLCMD d1,100,@LVSETTEXT,1,1,"Sub 1" 'the third column CONTROLCMD d1,100,@LVINSERTITEM,2,"Item 3" 'change some of the listview extended styles SENDMESSAGE d1,LVM_SETEXTENDEDLISTVIEWSTYLE,0,LVS_EX_FLATSB|LVS_EX_FULLROWSELECT|LVS_EX_GRIDLINES|LVS_EX_LABELTIP,100 'subclass the listview control hLV = GetDlgItem(d1.hwnd,100) origfp=GetWindowLongA(hLV,GWL_WNDPROC) 'Replace it with our handler... SetWindowLongA(hLV,GWL_WNDPROC,&myLVHandler) 'subclass the header control hHC = GetDlgItem(hLV,0) 'if listview not in report mode then hHC will be zero so don't 'attempt to subclass header control if its not existant IF(hHC) origfpHC=GetWindowLongA(hHC,GWL_WNDPROC) SetWindowLongA(hHC,GWL_WNDPROC,&myHCHandler) ENDIF 'set the check box control to initially checked SETSTATE d1,300,TRUE case @IDCONTROL SELECT @CONTROLID CASE 100 SELECT @NOTIFYCODE case @LVNCOLUMNCLICK 'someone clicked on a column header. Read the data from @LPARAM which is 'a pointer to a NMLISTVIEW UDT. Using the C dereferencing style makes 'it much easier. SETCONTROLTEXT d1,200,USING("Column ## clicked",*@LPARAM.iSubItem+1) case NM_CUSTOMDRAW 'if we want to change the colors of the actual items and subitems 'we need to do it here. Note you don't need to subclass the list view 'just to set the item/subitem colors so its a quick addition. SetWindowLongA(d1.hwnd,DWL_MSGRESULT,ColorListView(d1.hwnd,@LPARAM)) RETURN TRUE 'if used in a window use this line instead 'RETURN ColorListView(win.hwnd,@LPARAM) ENDSELECT CASE 300 'toggle the resize locking IF @NOTIFYCODE = 0 blocked = GetState(d1,300) lvc.mask=LVCF_ORDER for x=0 to 10 print x,sendmessage (d1,LVM_GETCOLUMNA,x,lvc,100 ) next x endif ENDSELECT CASE @IDDESTROY 'remove the subclasses if hHC AND origfpHC SetWindowLongA(hHC,GWL_WNDPROC,origfpHC) endif SetWindowLongA(hLV,GWL_WNDPROC,origfp) endselect return ENDSUB SUB ColorListView(hwnd as UINT,lParam as UINT),UINT DEF rv as UINT SELECT *lParam.nmcd.dwDrawStage CASE CDDS_PREPAINT rv = CDRF_NOTIFYITEMDRAW CASE CDDS_ITEMPREPAINT '*lParam.nmcd.dwItemSpec is the zero based item the control is drawing 'but we want to color each column item (subitem) individually rv =CDRF_NOTIFYSUBITEMDRAW CASE CDDS_SUBITEMPREPAINT '*lParam.iSubItem contains the zero based sub item number 'on system with IE 4.0 or greater installed. SELECT *lParam.iSubItem CASE 0:' the ITEM color *lParam.clrText = RGB(0,0,0) *lParam.clrTextBk = RGB(255,0,0) CASE 1:' the first sub item *lParam.clrText = RGB(0,0,0) *lParam.clrTextBk = RGB(0,255,0) DEFAULT: 'the color of the rest of the line *lParam.clrText = RGB(0,0,0) *lParam.clrTextBk = RGB(255,0,255) ENDSELECT rv = CDRF_NEWFONT DEFAULT rv = CDRF_DODEFAULT ENDSELECT RETURN rv ENDSUB 'message handler for the subclassed listview control SUB myLVHandler(hwnd:int,uMsg:int,wParam:int,lParam:pointer),int SELECT uMsg case WM_NOTIFY 'prevent columns from resizing. if (#lParam.code = HDN_BEGINTRACKA) OR (#lParam.code = HDN_BEGINTRACKW) if bLocked RETURN 1 endif ENDIF 'change the color of the header control columns. IF (#lParam.code = NM_CUSTOMDRAW) SELECT(#lParam.dwDrawStage) CASE CDDS_PREPAINT RETURN CDRF_NOTIFYITEMDRAW CASE CDDS_ITEMPREPAINT 'color the backound of the header columns first col blue, second yellow, third black 'change the text color of the first column while we are at it SELECT #lParam.dwItemSpec CASE 0 SetTextColor(#lParam.hDC,RGB(255,255,255)) SetBkColor(#lParam.hDC,RGB(50,50,255)) CASE 1 SetBkColor(#lParam.hDC,RGB(255,255,50)) CASE 2 SetTextColor(#lParam.hDC,RGB(255,255,255)) SetBkColor(#lParam.hDC,RGB(0,0,0)) ENDSELECT RETURN CDRF_NEWFONT ENDSELECT RETURN CDRF_DODEFAULT ENDIF ENDSELECT RETURN CallWindowProcA(origfp,hwnd,uMsg,wParam,lParam) ENDSUB 'message handler for the subclassed header control contained in the listview SUB myHCHandler(hwnd:int,uMsg:int,wParam:int,lParam:pointer),int 'return TRUE to prevent the header from changing the cursor. SELECT uMsg CASE WM_SETCURSOR IF bLocked RETURN 1 ENDIF CASE @IDLBUTTONDBLCLK IF bLocked RETURN 1 ENDIF ENDSELECT RETURN CallWindowProcA(origfpHC,hwnd,uMsg,wParam,lParam) ENDSUB