Hello All
at last i got this important listview out, that contains a multiline header
Thanxx a lot to Charles and Jose
but still having a bit of a problem with the Statusbar which floats upwards when you scroll
up and down the listview
anyway it is a proof of concept
ColorListView_MH/o2bas listing
'====================================================================
' Color Listview example modified Nov 4 2018
' which you can change fonts and color of text and background
' with Multi Line Header
'====================================================================
$ filename "ColorListView_MH.exe"
use rtl64
#lookahead
' % review
uses dialogs
uses O2Common
'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))
% DS_CENTER=0x0800
% DS_MODALFRAME=0x80
% SS_CENTERIMAGE=0x200
% 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
% WM_SIZING = &H214
% WM_MOVING = &H216
% CLR_NONE = &HFFFFFFFF
' % GWLP_WNDPROC= -4
% GWLP_WNDPROC= dword -4
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
' Number of rows in the ListView
% NumRow = 200
' Number of columns in the ListView meaning 3 +1 = 4 columns
% NumCol = 3
! GetDlgItem lib "user32.dll" (sys hDlg, int nIDDlgItem) as sys
! IsDialogMessage lib "user32.dll" alias"IsDialogMessageA" (sys hDlg, sys lpMsg) as bool
! IsWindow lib "user32.dll" (sys hWnd) as bool
uses MultiLineHDO2
' 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
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 = ""
Else
txtStr="Column #" & str(i+1) + cr + " level2 "
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
sys lpdt
MSG wMsg
dyn::init(lpdt)
Dialog( 1, 10,10,250,200, "Listview example 64bits ", lpdt,
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,233,50, WS_EX_CLIENTEDGE
hFont = O2ApiCreateFont("Arial",9, FW_Bold)
hDlg = CreateModelessDialog( 0, @DlgProc, 0, lpdt )
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
MultiLineHDO2.inc listing
' MultiLineHDO2.inc
' MultiLine Header routines for O2
' Updated : Nov 4 2018
Type WINDOWPOS
hwnd As sys
hWndInsertAfter As sys
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type
' // Size = 8 bytes
TYPE HD_LAYOUT
RECT PTR prc ' RECT *prc
WINDOWPOS PTR pwpos ' WINDOWPOS *pwpos
END TYPE
TYPE NMCUSTOMDRAW
hdr AS NMHDR ' NMHDR hdr
dwDrawStage AS sys ' DWORD dwDrawStage
hdc AS sys ' HDC hdc
rc AS RECT ' RECT rc
dwItemSpec AS sys ' DWORD_PTR dwItemSpec // this is control specific, but it's how to specify an item. valid only with CDDS_ITEM bit set
uItemState AS uint ' UINT uItemState
lItemlParam AS sys ' LPARAM lItemlParam
END TYPE
TYPE HD_ITEM
Mask AS uint ' UINT mask
cxy AS LONG ' int cxy
pszText AS ASCIIZ PTR ' LPSTR pszText
hbm AS sys ' HBITMAP hbm
cchTextMax AS LONG ' int cchTextMax
fmt AS LONG ' int fmt
lParam AS sys ' LPARAM lParam
iImage AS LONG ' int iImage // index of bitmap in ImageList
iOrder AS LONG ' int iOrder // where to draw this item
pvFilter AS sys ' void * pvFilter // [in] fillter data see above
state AS sys
END TYPE
TYPE HD_ITEMA
Mask AS uint ' UINT mask
cxy AS LONG ' int cxy
char* pszText ' ASCIIZ PTR ' LPSTR pszText
hbm AS sys ' HBITMAP hbm
cchTextMax AS LONG ' int cchTextMax
fmt AS LONG ' int fmt
lParam AS sys ' LPARAM lParam
iImage AS LONG ' int iImage // index of bitmap in ImageList
iOrder AS LONG ' int iOrder // where to draw this item
pvFilter AS sys ' void * pvFilter // [in] fillter data see above
state AS sys
END TYPE
% SWP_FRAMECHANGED = &H20
% CDRF_NOTIFYITEMDRAW = &H20
% CDRF_SKIPDEFAULT = &H00000004
% HDI_TEXT = &H0002
% CDDS_PREPAINT = &H00000001
% CDDS_ITEM = &H00010000
% CDDS_ITEMPREPAINT = CDDS_ITEM OR CDDS_PREPAINT
% NM_FIRST = 0
% NM_CUSTOMDRAW = NM_FIRST - 12
% HDM_FIRST = &H1200
% HDM_LAYOUT = HDM_FIRST + 5
% HDM_GETITEMA = HDM_FIRST + 3
% HDM_GETITEMW = HDM_FIRST + 11
% DT_CENTER = &H00000001
% DT_VCENTER = &H00000004
'// itemState flags
% CDIS_SELECTED = &H0001
% DFC_BUTTON = 4
% DFCS_BUTTONPUSH = &H0010
% DFCS_PUSHED = &H00000200
' ========================================================================================
' Gets the handle to the header control used by a list-view control.
' ========================================================================================
FUNCTION ListView_GetHeader (BYVAL hwndLV AS sys) AS sys
FUNCTION = SendMessage(hwndLV, LVM_GETHEADER, 0, 0)
END FUNCTION
' ========================================================================================
FUNCTION Header_GetItemW (BYVAL hwndHD AS sys, BYVAL iItem AS sys, BYREF phdi AS HD_ITEM) AS sys
FUNCTION = SendMessageW( hwndHD, HDM_GETITEMW, iItem, VARPTR(phdi))
END FUNCTION
' ========================================================================================
' Gets information about an item in a header control.
' ========================================================================================
FUNCTION Header_GetItemA (BYVAL hwndHD AS sys, BYVAL iItem AS sys, BYREF phdi AS HD_ITEMA ) AS sys
FUNCTION = SendMessage(hwndHD, HDM_GETITEMA, iItem, VARPTR(phdi))
END FUNCTION
' ============================================================================
' Processes messages for the subclassed ListView header control.
FUNCTION LVHeader_SubclassProc( BYVAL hwnd AS sys , BYVAL usMsg AS uint ,
BYVAL wParam AS sys, BYVAL lParam AS sys ) AS sys callback
SELECT CASE usMsg
CASE WM_DESTROY
' REQUIRED: Remove control subclassing
SetWindowLongPtr hWnd, GWLP_WNDPROC, RemoveProp(hWnd, "OLDWNDPROC")
CASE %HDM_LAYOUT
' Fill the WINDOWPOS structure with
' the appropriate size and position of the
' header control and change the top position
' of the rectangle that the header
' control will occupy.
HD_LAYOUT phdl at (lparam)
phdl.pwpos.hwnd = hWnd
phdl.pwpos.flags = SWP_FRAMECHANGED
phdl.pwpos.x = phdl.prc.Left
phdl.pwpos.y = 0
phdl.pwpos.cx = phdl.prc.Right - phdl.prc.Left
phdl.pwpos.cy = 40 ' --> change me
phdl.prc.Top = 40 ' --> change me
FUNCTION = -1
EXIT FUNCTION
END SELECT
FUNCTION = CallWindowProc(GetProp(hWnd, "OLDWNDPROC"), hWnd, usMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' Processes messages for the subclassed ListView control.
FUNCTION ListView_SubclassProc ( _
BYVAL hWnd AS sys, _
BYVAL utMsg AS uint, _
BYVAL wParam AS sys, _
BYVAL lParam AS sys ) AS sys callback
' Header text
static char szText[260]
' REQUIRED: Get the address of the original window procedure
sys pOldWndProc
pOldWndProc = GetProp(hWnd, "OLDWNDPROC")
SELECT CASE utMsg
CASE WM_DESTROY
' REQUIRED: Remove control subclassing
RemoveProp(hWnd, "OLDWNDPROC", GetWindowLongPtr(hWnd, GWLP_WNDPROC, @ListView_SubclassProc))
CASE WM_NOTIFY
NMHDR PTR pnmh
NMCUSTOMDRAW PTR pnmcd
@pnmh = lParam
SELECT CASE pnmh.code
CASE NM_CUSTOMDRAW
@pnmcd = lParam
' Check the drawing stage
SELECT CASE pnmcd.dwDrawStage
' Prior to painting
CASE CDDS_PREPAINT
' Tell Windows we want individual notification
' of each item being drawn
FUNCTION = CDRF_NOTIFYITEMDRAW
EXIT FUNCTION
' Notification of each item being drawn
CASE CDDS_ITEMPREPAINT
sys hLvHeader
sys nIndex
sys nState
nIndex = pnmcd.dwItemSpec
nState = pnmcd.uItemState
' Get the header item text...
HD_ITEMA hdi
hdi.mask = HDI_TEXT
hdi.pszText = strptr(szText)
hdi.cchtextmax = 260 'SIZEOF(szText)
hLvHeader = ListView_GetHeader(hWnd)
Header_GetItemA(hLvHeader, nIndex, hdi)
' Create a new font
sys hFont
hFont = O2ApiCreateFont("Tahoma", 10, FW_BOLD)
' Select the font into the current devide context
sys hOldFont
hOldFont = SelectObject(pnmcd.hdc, hFont)
' Draw the button state...
IF (nState AND CDIS_SELECTED) THEN
DrawFrameControl pnmcd.hdc, pnmcd.rc, _
DFC_BUTTON, DFCS_BUTTONPUSH OR DFCS_PUSHED
ELSE
DrawFrameControl pnmcd.hdc, pnmcd.rc, _
DFC_BUTTON, DFCS_BUTTONPUSH
END IF
' Color the header background
sys hBrush
hBrush = CreateSolidBrush(RGB(243,250,5)) ' <------------ Change color
InflateRect pnmcd.rc, -2, -2
FillRect pnmcd.hdc, pnmcd.rc, hBrush
SetBkMode pnmcd.hdc, TRANSPARENT
' Color the header text
' SetTextColor pnmcd.hdc, RGB(40,45,215) ' <------------ Change color
SetTextColor pnmcd.hdc, RGB(0,0,215)
' Offset the text slightly if depressed...
IF (nState AND CDIS_SELECTED) THEN
InflateRect pnmcd.rc, -2, -2
END IF
' Draw multiline, using carriage returns (i.e. szText = "Customer" + CR + "number")
DrawText pnmcd.hdc, szText, LEN(szText), pnmcd.rc, DT_CENTER OR DT_VCENTER
' Cleanup
IF hBrush THEN
DeleteObject hBrush
END IF
IF hOldFont THEN
SelectObject pnmcd.hdc, hOldFont
END IF
IF hFont THEN
DeleteObject hFont
END IF
' Tell Windows the item has already been drawn
FUNCTION = CDRF_SKIPDEFAULT
EXIT FUNCTION
END SELECT
END SELECT
END SELECT
FUNCTION = CallWindowProc(pOldWndProc, hWnd, utMsg, wParam, lParam)
END FUNCTION
this is the screen shot of the program
BTW Charles
previously, the main problem lies with the SIZEOF() function which did not work
so to resolve this i set the text size to 260
hdi.pszText = strptr(szText)
hdi.cchtextmax = 260 ' SIZEOF(szText)
it seems that PB SIZEOF() function cannot be translated directly to O2 ?
i also changed VARPTR() to strptr()
Well done!
You may want to update your List view with Roland's later version of Dialogs.inc:
https://www.oxygenbasic.org/forum/index.php?topic=1525.30
message #37
I noticed the dialog(...) parameters are different.
Thanxx Charles
i have already modified the code to cater for this new Dialog.inc
and its source code has been submitted at the Example Source code subsection