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
'====================================================================
' 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
Chris,
Many thanks, this is a splendid code!!!
you are most welcome Karen
i luv O2 as this is the most flexible programming language