Here is a set of ListView wrapper functions. This is 32-bit code with 4-byte default integers, may have to be modified for 64-bits.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! List view functions
!
!
! Adds a new column to a list view. The columnIndex is both the
! column position in the list view and the index of the associated
! subitem. The title is displayed for the column in the list view
! header, and the width is the column width in pixels.
!
SUBROUTINE ListViewAddColumn (hwnd, controlId, columnIndex, title, width, extraFormat)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(IN) :: columnIndex
CHARACTER(LEN=*), INTENT(IN) :: title
INTEGER, INTENT(IN) :: width
INTEGER, INTENT(IN),OPTIONAL :: extraFormat
TYPE(T_LV_COLUMN) :: column
INTEGER :: rval
column%iSubItem = columnIndex
column%pszText = LOC(title)
column%cx = width
column%mask = IOR(LVCF_SUBITEM, LVCF_WIDTH)
! extraFormat denotes text_is_centered or item_is_an_image
IF (PRESENT(extraFormat)) THEN
column%fmt = extraFormat
column%mask = IOR(LVCF_FMT, column%mask)
IF (extraFormat /= LVCFMT_IMAGE) column%mask = IOR(column%mask, LVCF_TEXT)
! if there is no extra argument, text content is assumed
ELSE
column%mask = IOR(column%mask, LVCF_TEXT)
END IF
rval = SendControlMessage(hwnd, controlId, LVM_INSERTCOLUMN, columnIndex, LOC(column))
IF(rval == -1) THEN
CALL ControlError("ListViewAddColumn", controlId, "failed")
END IF
END SUBROUTINE ListViewAddColumn
!
! Returns the number of items in a list view.
!
INTEGER FUNCTION ListViewGetNumItems(hwnd, controlId)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER :: rval
rval = SendControlMessage(hwnd, controlId, LVM_GETITEMCOUNT, 0, 0)
IF(rval >= 0) THEN
ListViewGetNumItems = rval
ELSE
CALL ControlError("ListViewGetNumItems", controlId, &
"LVM_GETITEMCOUNT")
ListViewGetNumItems = 0
END IF
END FUNCTION ListViewGetNumItems
SUBROUTINE ListViewWideHighlight (hwnd, controlId)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER :: rval
rval = SendControlMessage (hwnd, controlId, &
LVM_SETEXTENDEDLISTVIEWSTYLE, &
LVS_EX_FULLROWSELECT, &
LVS_EX_FULLROWSELECT)
END SUBROUTINE ListViewWideHighlight
! enable hover-detection for a listview control; hover information
! is returned via LVN_HOTTRACK messages within WM_NOTIFY, and in this
! program HandleListViewClick is used to resolve the selected item
SUBROUTINE ListViewHoverEnable (hwnd, controlId)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER :: rval
rval = SendControlMessage (hwnd, controlId, &
LVM_SETEXTENDEDLISTVIEWSTYLE, &
LVS_EX_TRACKSELECT, &
LVS_EX_TRACKSELECT)
END SUBROUTINE ListViewHoverEnable
!
! Removes all the items in a list view.
!
SUBROUTINE ListViewDeleteAllItems (hwnd, controlId)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER :: rval
rval = SendControlMessage(hwnd, controlId, LVM_DELETEALLITEMS, 0, 0)
IF (rval == 0) THEN
CALL ControlError("ListViewDeleteAllItems", controlId, &
"LVM_DELETEALLITEMS")
END IF
rval = SendControlMessage(hwnd, controlId, LVM_UPDATE, 0, 0)
IF( rval == 0) THEN
CALL ControlError("ListViewDeleteAllItems", controlId, &
"LVM_UPDATE")
END IF
END SUBROUTINE ListViewDeleteAllItems
!
! Adds an item to a list view. Returns the 1-based item index,
! or -1 if the operation fails.
!
INTEGER FUNCTION ListViewAddItem (hwnd, controlId, name)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER :: rval
INTEGER :: nItems
TYPE(T_LV_ITEM) :: item
CHARACTER(LEN=200) :: buffer
buffer = name
CALL NullTerminateString (buffer)
nItems = ListViewGetNumItems (hwnd, controlId)
item%mask = LVIF_TEXT
item%iItem = nItems
item%iSubitem = 0
item%pszText = LOC(buffer)
rval = SendControlMessage(hwnd, controlId, LVM_INSERTITEM, 0, LOC(item))
IF(rval /= -1) THEN
ListViewAddItem = rval + 1
ELSE
CALL ControlError("ListViewAddItem", controlId, "LVM_INSERTITEM")
ListViewAddItem = -1
END IF
END FUNCTION ListViewAddItem
!
! Sets the text in a column for a single item in a list view control.
! itemindex = row
SUBROUTINE ListViewSetColumn (hwnd, controlId, row, column, text, color)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(IN) :: row
INTEGER, INTENT(IN) :: column
CHARACTER(LEN=*), INTENT(IN) :: text
INTEGER, INTENT(IN), OPTIONAL :: color
INTEGER :: rval
TYPE(T_LV_ITEM) :: item
CHARACTER(LEN=200) :: buffer
IF (PRESENT(color)) then
rval = SendControlMessage (hwnd, controlId, LVM_SETTEXTCOLOR, 0, color)
END IF
buffer = text
CALL NullTerminateString(buffer)
item%mask = LVIF_TEXT
item%iItem = row - 1 ! row is 1-based
item%iSubitem = column ! column is 0-based
item%pszText = LOC(buffer)
rval = SendControlMessage (hwnd, controlId, LVM_SETITEM, 0, LOC(item))
IF (rval == -1) THEN
CALL ControlError("ListViewSetColumn", controlId, "LVM_SETITEM")
END IF
END SUBROUTINE ListViewSetColumn
SUBROUTINE ListViewSetImage (hwnd, controlId, row, column, image)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(IN) :: row
INTEGER, INTENT(IN) :: column
INTEGER, INTENT(IN) :: image
INTEGER :: rval
TYPE(T_LV_ITEM) :: item
item%mask = LVIF_IMAGE
item%iItem = row - 1 ! row is 1-based
item%iSubitem = column ! column is 0-based
item%iImage = image
rval = SendControlMessage (hwnd, controlId, LVM_SETITEM, 0, LOC(item))
IF (rval == -1) THEN
CALL ControlError("ListViewSetImage", controlId, "LVM_SETITEM")
END IF
END SUBROUTINE ListViewSetImage
SUBROUTINE ListViewSetColumnHeader (hwnd, controlId, zb_colpos, text)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(IN) :: zb_colpos ! zero-based column position
CHARACTER(LEN=*), INTENT(IN) :: text
INTEGER :: rval
TYPE(T_LVCOLUMN) :: lvcolumn
CHARACTER(LEN=100) :: buffer
buffer = text
CALL NullTerminateString(buffer)
lvcolumn%mask = LVCF_TEXT
lvcolumn%pszText = LOC(buffer)
lvcolumn%cchTextMax = INDEX(buffer,CHAR(0))
rval = SendControlMessage (hwnd, controlId, LVM_SETCOLUMN, zb_colpos, LOC(lvcolumn))
IF (rval == -1) THEN
CALL ControlError("ListViewSetColumnHeader", controlId, "LVM_SETCOLUMN")
END IF
END SUBROUTINE ListViewSetColumnHeader
!
! Sets the specified item in a list view control to selected. The
! index argument is 1-based.
!
SUBROUTINE ListViewSetSelectedIndex(hwnd, controlId, index)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(IN) :: index
INTEGER :: rval
TYPE(T_LV_ITEM) :: item
item%iItem = index - 1
item%iSubitem = 0
item%mask = LVIF_STATE
item%state = LVIS_SELECTED
item%stateMask = LVIS_SELECTED
rval = SendControlMessage (hwnd, controlId, LVM_SETITEM, 0, LOC(item))
IF (rval == -1) THEN
CALL ControlError("ListViewSetSelectedIndex", controlId, &
"LVM_SETITEM")
END IF
END SUBROUTINE ListViewSetSelectedIndex
SUBROUTINE ListViewDeselect (hwnd, controlId)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER :: index
INTEGER :: rval
TYPE(T_LV_ITEM) :: item
index = ListViewGetSelectedIndex (hwnd, controlId)
IF (index /= -1) THEN
item%iItem = index - 1
item%iSubitem = 0
item%mask = LVIF_STATE
item%state = 0
item%stateMask = LVIS_SELECTED
rval = SendControlMessage (hwnd, controlId, LVM_SETITEM, 0, LOC(item))
IF (rval == -1) THEN
CALL ControlError("ListViewSetSelectedIndex", controlId, &
"LVM_SETITEM")
END IF
END IF
END SUBROUTINE ListViewDeselect
!
! Returns the 1-based index of the currently selected item in a list view,
! or -1 if nothing is selected.
!
INTEGER FUNCTION ListViewGetSelectedIndex (hwnd, controlId, top) RESULT(index)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(INOUT),OPTIONAL:: top
INTEGER :: rval
INTEGER :: nItems
TYPE(T_LV_ITEM) :: lvitem
TYPE(T_RECT) :: rect
INTEGER :: i
nItems = ListViewGetNumItems (hwnd, controlId)
DO i = 0, nItems - 1
lvitem%mask = LVIF_STATE
lvitem%iItem = i
lvitem%iSubitem = 0
lvitem%stateMask = LVIS_SELECTED
rval = SendControlMessage (hwnd, controlId, LVM_GETITEM, 0, LOC(lvitem))
IF(rval /= 0) THEN
IF (lvitem%state == LVIS_SELECTED) THEN
IF (PRESENT(top)) THEN
rval = SendControlMessage (hwnd, controlId, LVM_GETITEMRECT, i, LOC(re
top = rect%top
END IF
index = i + 1
RETURN
END IF
ELSE
CALL ControlError("ListViewGetSelectedItem", controlId, "LVM_GETITEM")
END IF
END DO
index = -1
END FUNCTION ListViewGetSelectedIndex
!
! Associates an integer value with a list view item, which can later
! be retrieved with ListViewGetItemData.
!
! If the data is being stored for later use with NM_CUSTOMDRAW, such as
! for setting a custom color for each element in the LV, this associated
! integer vaue is returned within the NM_CUSTOMDRAW data structure as
! nmlvcd%nmcd%lItemlParam
SUBROUTINE ListViewSetItemData (hwnd, controlId, index, valu)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(IN) :: index
INTEGER, INTENT(IN) :: valu
INTEGER :: rval
TYPE(T_LV_ITEM) :: item
item%iItem = index - 1
item%iSubitem = 0
item%mask = LVIF_PARAM
item%lparam = valu
rval = SendControlMessage(hwnd, controlId, LVM_SETITEM, 0, LOC(item))
IF(rval == -1) THEN
CALL ControlError("ListViewSetItemData", controlId, "LVM_SETITEM")
END IF
END SUBROUTINE ListViewSetItemData
!
! Retrieves an integer data value associated with a list view item.
! If the operation fails, -1 is returned.
!
INTEGER FUNCTION ListViewGetItemData(hwnd, controlId, index) RESULT(valu)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(IN) :: index
INTEGER :: rval
TYPE(T_LV_ITEM) :: item
item%iItem = index - 1
item%iSubitem = 0
item%mask = LVIF_PARAM
rval = SendControlMessage(hwnd, controlId, LVM_GETITEM, 0, LOC(item))
IF(rval /= -1) THEN
valu = item%lparam
ELSE
CALL ControlError("ListViewGetItemData", controlId, "LVM_GETITEM")
valu = -1
END IF
END FUNCTION ListViewGetItemData
!
! Retrieves the integer data value associated with the currently
! selected item in the list view, or -1 if no item is currently
! selected.
!
INTEGER FUNCTION ListViewGetSelectedData(hwnd, controlId) RESULT(valu)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER :: sel
sel = ListViewGetSelectedIndex(hwnd, controlId)
IF(sel /= -1) THEN
valu = ListViewGetItemData(hwnd, controlId, sel)
ELSE
valu = -1
END IF
END FUNCTION ListViewGetSelectedData
! Call this function in response to the NM_CLICK message. It
! causes a row to be selected if it is clicked on anywhere, not
! just in the first column.
!
SUBROUTINE HandleListViewClick (hwnd, controlId, got_one)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
LOGICAL, INTENT(OUT),OPTIONAL :: got_one
INTEGER :: rval
INTEGER :: nItems
INTEGER(HANDLE) :: hwndControl
INTEGER :: i
TYPE(T_RECT) :: rect
TYPE(T_POINT) :: position
TYPE(T_LV_ITEM) :: item
IF (PRESENT(got_one)) got_one = .FALSE.
IF (n_enterwindows /= 0) RETURN
! Probably should be GetMessagePos, but that's broken in DVF's
! headers, and this fills the bill OK.
rval = GetCursorPos (position)
hwndControl = DialogGetControlWindow (hwnd, controlId)
rval = ScreenToClient (hwndControl, position)
nItems = SendControlMessage (hwnd, controlId, LVM_GETITEMCOUNT, 0, 0)
DO i = 0, nItems - 1
rect%left = LVIR_BOUNDS
rval = SendControlMessage(hwnd, controlId, LVM_GETITEMRECT, i, LOC(rect))
IF (PtInRect(rect, position)) THEN
item%mask = LVIF_STATE
item%state = IOR(LVIS_SELECTED, LVIS_FOCUSED)
item%stateMask = IOR(LVIS_SELECTED, LVIS_FOCUSED)
rval = SendControlMessage (hwnd, controlId, LVM_SETITEMSTATE, i, LOC(item))
IF (PRESENT(got_one)) got_one = .TRUE.
EXIT
END IF
END DO
END SUBROUTINE HandleListViewClick
! resolve a listview NM_HOVER message into the 1-based
! index of the listview item which is being hovered over;
SUBROUTINE ListViewHover (hwnd, controlId, item)
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN) :: hwnd
INTEGER, INTENT(IN) :: controlId
INTEGER, INTENT(OUT) :: item
INTEGER :: rval, i
INTEGER :: nItems
INTEGER(HANDLE) :: hwndControl
TYPE(T_RECT) :: rect
TYPE(T_POINT) :: position
! Probably should be GetMessagePos, but that's broken in DVF's
! headers, and this fills the bill OK.
rval = GetCursorPos (position)
hwndControl = DialogGetControlWindow (hwnd, controlId)
rval = ScreenToClient (hwndControl, position)
nItems = SendControlMessage (hwnd, controlId, LVM_GETITEMCOUNT, 0, 0)
DO i = 0, nItems - 1
rect%left = LVIR_BOUNDS
rval = SendControlMessage(hwnd, controlId, LVM_GETITEMRECT, i, LOC(rect))
IF (PtInRect(rect, position)) THEN
item = i + 1
RETURN
END IF
END DO
item = 0
END SUBROUTINE ListViewHover
