In practice, the custom drawing is shorter if you do a few calculations like RASHAD's code.
Fixed some glitches in the previous code.
Code: Select all
Import "Msimg32.lib"
TransparentBlt(hdcDest, xoriginDest.l, yoriginDest.l, wDest.l, hDest.l, hdcSrc, xoriginSrc.l, yoriginSrc.l, wSrc.l, hSrc.l, crTransparent.l)
EndImport
Procedure Add_Icon_To_ImageList(ImgList, DLL_Path.s, index)
Protected hIcon, img_index = -1
hIcon = ExtractIcon_(#Null, DLL_Path, index)
If hIcon
img_index = ImageList_AddIcon_(ImgList, hIcon)
DestroyIcon_(hIcon)
Else
ProcedureReturn -1
EndIf
ProcedureReturn img_index
EndProcedure
Procedure ListIcon_SetItemImage(tempListIconGadget, index_item.w, index_subitem.w, index_image.w)
Protected itemLV.LVITEM ; tagLVITEM
itemLV\mask = #LVIF_IMAGE
itemLV\iItem = index_item
itemLV\iSubItem = index_subitem
itemLV\iImage = index_image
If Not SendMessage_(GadgetID(tempListIconGadget), #LVM_SETITEM, 0, @itemLV)
Debug "#LVM_SETITEM error"
EndIf
EndProcedure
Structure LVBKIMAGE Align #PB_Structure_AlignC
ulFlags.l
hbm.i
pszImage.s
cchImageMax.l
xOffsetPercent.l
yOffsetPercent.l
EndStructure
#LVBKIF_SOURCE_NONE = 0
#LVBKIF_SOURCE_HBITMAP = 1
#LVBKIF_STYLE_TILE = 16
Global ListIcon
Global ImgListIconBk0, ImgListIconBk1, ListIconBkColor0.l, ListIconBkColor1.l
Global KeyPressed
Global OldWndProc
Procedure SetListIconBkImage(Gadget, Image)
Protected iResult, hdc, hdcDst, hBitmap, w, h, lvi.LVBKIMAGE, old
If Image
w = ImageWidth(Image)
h = ImageHeight(Image)
If w = 0 Or h = 0 : ProcedureReturn 0 : EndIf
; https://learn.microsoft.com/en-us/windows/win32/api/commctrl/ns-commctrl-lvbkimagew
; #LVBKIF_SOURCE_HBITMAP
; "A background bitmap is supplied via the hbm member of LVBKIMAGE. If the message LVM_SETBKIMAGE succeeds, then the list-view takes ownership of the bitmap."
; The ListIconGadget takes ownership of the image, so you need to create a new bitmap and pass it over.
; The bitmap is internally destroyed when the image is replaced.
hdc = StartDrawing(ImageOutput(Image))
If hdc
hdcDst = CreateCompatibleDC_(hdc)
If hdcDst
hBitmap = CreateCompatibleBitmap_(hdc, w, h)
If hBitmap
old = SelectObject_(hdcDst, hBitmap)
BitBlt_(hdcDst, 0, 0, w, h, hdc, 0, 0, #SRCCOPY)
SelectObject_(hdcDst, old)
lvi\ulFlags = #LVBKIF_SOURCE_HBITMAP | #LVBKIF_STYLE_TILE
lvi\hbm = hBitmap
iResult = SendMessage_(GadgetID(Gadget), #LVM_SETBKIMAGE, 0, lvi)
EndIf
DeleteDC_(hdcDst)
EndIf
StopDrawing()
EndIf
EndIf
ProcedureReturn iResult
EndProcedure
Procedure SetListIconLineColors(Gadget, Color1.l = #White, Color2.l = $CCCCCC)
Protected iResult, iClear, w, h, rt.RECT, iCount, iPageItems, i, ImgTmp
If GadgetType(Gadget) <> #PB_GadgetType_ListIcon : ProcedureReturn 0 : EndIf
If GetSysColor_(#COLOR_HIGHLIGHTTEXT) = Color1
Color1 - 1
EndIf
iCount = CountGadgetItems(Gadget)
If iCount = 0
AddGadgetItem(Gadget, -1, "test")
iClear = 1
EndIf
w = GadgetWidth(Gadget)
If w = 0 : w = 100 : EndIf
rt\left = #LVIR_BOUNDS
SendMessage_(GadgetID(Gadget), #LVM_GETITEMRECT, 0, rt)
h = rt\bottom - rt\top
iPageItems = SendMessage_(GadgetID(Gadget), #LVM_GETCOUNTPERPAGE, 0, 0)
If iCount > iPageItems
If ImgListIconBk0 : FreeImage(ImgListIconBk0) : EndIf
ImgListIconBk0 = CreateImage(#PB_Any, w, h * 2)
If ImgListIconBk0
If StartDrawing(ImageOutput(ImgListIconBk0))
Box(0, 0, w, h * 2, Color1)
Box(0, h, w, h * 2, Color2)
StopDrawing()
EndIf
EndIf
If ImgListIconBk1 : FreeImage(ImgListIconBk1) : EndIf
ImgListIconBk1 = CreateImage(#PB_Any, w, h * 2)
If ImgListIconBk1
If StartDrawing(ImageOutput(ImgListIconBk1))
Box(0, 0, w, h * 2, Color2)
Box(0, h, w, h * 2, Color1)
StopDrawing()
EndIf
EndIf
iResult = SetListIconBkImage(Gadget, ImgListIconBk0)
Else
ImgTmp = CreateImage(#PB_Any, w, h * iPageItems, 24, Color1)
If ImgTmp
iCount - 2
If StartDrawing(ImageOutput(ImgTmp))
For i = 0 To iCount Step 2
Box(0, h * i, w, h, Color1)
Box(0, h * (i + 1), w, h, Color2)
Next
StopDrawing()
iResult = SetListIconBkImage(Gadget, ImgTmp)
EndIf
FreeImage(ImgTmp)
EndIf
EndIf
If iResult
ListIconBkColor0 = color1
ListIconBkColor1 = color2
EndIf
If iClear : ClearGadgetItems(Gadget) : EndIf
ProcedureReturn iResult
EndProcedure
Procedure WndProc_ListIcon(hWnd, Message, wParam, lParam)
Protected iIdxFirst, iPageItems, img
Select Message
Case #WM_SETFOCUS
SendMessage_(hWnd, #WM_CHANGEUISTATE, #UIS_CLEAR | (#UISF_HIDEFOCUS << 16), 0)
Case #WM_PAINT, #WM_KILLFOCUS
iIdxFirst = SendMessage_(hWnd, #LVM_GETTOPINDEX, 0, 0)
iPageItems = SendMessage_(GadgetID(ListIcon), #LVM_GETCOUNTPERPAGE, 0, 0)
SendMessage_(GadgetID(ListIcon), #LVM_REDRAWITEMS, iIdxFirst, iIdxFirst + iPageItems)
Case #WM_KEYDOWN
Select wParam
Case #VK_UP, #VK_DOWN, #VK_PRIOR, #VK_NEXT, #VK_HOME, #VK_END
KeyPressed = 1
EndSelect
Case #WM_KEYUP
KeyPressed = 0
iIdxFirst = SendMessage_(hWnd, #LVM_GETTOPINDEX, 0, 0)
If iIdxFirst % 2
img = ImgListIconBk1
Else
img = ImgListIconBk0
EndIf
SetListIconBkImage(ListIcon, img)
EndSelect
ProcedureReturn CallWindowProc_(OldWndProc, hWnd, Message, wParam, lParam)
EndProcedure
Procedure WndProc(hWnd, Message, wParam, lParam)
Protected iResult = #PB_ProcessPureBasicEvents
Protected img, iIdxFirst, iPageItems, *lparam.NMHDR, *lvcd.NMLVCUSTOMDRAW, iSetBk, rt.RECT, rtIcon.RECT
Protected w, h, BkColor, ItemSelected, hdcMem, hBitmap, old, hBrush
If Message = #WM_NOTIFY
If lParam
*lparam = lParam
If *lparam\hwndFrom = GadgetID(ListIcon)
iIdxFirst = SendMessage_(*lparam\hwndFrom, #LVM_GETTOPINDEX, 0, 0)
Select *lparam\code
Case #NM_CUSTOMDRAW
*lvcd = lParam
Select *lvcd\nmcd\dwDrawStage
Case #CDDS_ITEMPREPAINT
ProcedureReturn #CDRF_NOTIFYPOSTPAINT
Case #CDDS_ITEMPOSTPAINT
ItemSelected = Bool(GetGadgetItemState(ListIcon, *lvcd\nmcd\dwItemSpec) & #PB_ListIcon_Selected)
If ItemSelected = 0 : ProcedureReturn #PB_ProcessPureBasicEvents : EndIf
If GetWindowLongPtr_(GadgetID(ListIcon), #GWL_STYLE) & #LVS_SHOWSELALWAYS <> #LVS_SHOWSELALWAYS And GetActiveGadget() <> ListIcon
ProcedureReturn #PB_ProcessPureBasicEvents
EndIf
rt\left = #LVIR_BOUNDS
SendMessage_(GadgetID(ListIcon), #LVM_GETITEMRECT, *lvcd\nmcd\dwItemSpec, rt)
rtIcon\left = #LVIR_ICON
SendMessage_(GadgetID(ListIcon), #LVM_GETITEMRECT, *lvcd\nmcd\dwItemSpec, rtIcon)
rt\left + rtIcon\right
w = rt\right - rt\left
h = rt\bottom - rt\top
If ItemSelected And GetActiveGadget() = ListIcon
BkColor = GetSysColor_(#COLOR_HIGHLIGHT)
Else
BkColor = GetSysColor_(#COLOR_BTNFACE)
EndIf
hdcMem = CreateCompatibleDC_(*lvcd\nmcd\hdc)
If hdcMem
hBitmap = CreateCompatibleBitmap_(*lvcd\nmcd\hdc, w, h)
If hBitmap
old = SelectObject_(hdcMem, hBitmap)
If *lvcd\nmcd\uItemState & #CDIS_FOCUS
DrawFocusRect_(*lvcd\nmcd\hdc, rt)
EndIf
BitBlt_(hdcMem, 0, 0, w, h, *lvcd\nmcd\hdc, rt\left, rt\top, #SRCCOPY)
hBrush = CreateSolidBrush_(BkColor)
If hBrush
FillRect_(*lvcd\nmcd\hdc, rt, hBrush)
DeleteObject_(hBrush)
EndIf
If *lvcd\nmcd\dwItemSpec % 2
TransparentBlt(*lvcd\nmcd\hdc, rt\left, rt\top, w, h, hdcMem, 0, 0, w, h, ListIconBkColor1)
Else
TransparentBlt(*lvcd\nmcd\hdc, rt\left, rt\top, w, h, hdcMem, 0, 0, w, h, ListIconBkColor0)
EndIf
If *lvcd\nmcd\uItemState & #CDIS_FOCUS
DrawFocusRect_(*lvcd\nmcd\hdc, rt)
EndIf
SelectObject_(hdcMem, old)
DeleteObject_(hBitmap)
EndIf
DeleteDC_(hdcMem)
EndIf
EndSelect
If KeyPressed And *lvcd\nmcd\uItemState & #CDIS_FOCUS
iSetBk = 1
Else
ProcedureReturn iResult
EndIf
Case #LVN_ENDSCROLL
iSetBk = 1
Case #LVN_ITEMCHANGING, #NM_SETFOCUS
iPageItems = SendMessage_(GadgetID(ListIcon), #LVM_GETCOUNTPERPAGE, 0, 0)
SendMessage_(GadgetID(ListIcon), #LVM_REDRAWITEMS, iIdxFirst, iIdxFirst + iPageItems)
EndSelect
If iSetBk
If iIdxFirst % 2
img = ImgListIconBk1
Else
img = ImgListIconBk0
EndIf
SetListIconBkImage(ListIcon, img)
EndIf
EndIf
EndIf
EndIf
ProcedureReturn iResult
EndProcedure
Define Window = OpenWindow(#PB_Any, 0, 0, 464, 462, "Image transparency", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIcon = ListIconGadget(#PB_Any, 34, 30, 388, 402, "Col 1", 100, #PB_ListIcon_FullRowSelect); | #PB_ListIcon_AlwaysShowSelection); | #PB_ListIcon_MultiSelect)
AddGadgetColumn(ListIcon, 1, "Col 2", 100)
AddGadgetColumn(ListIcon, 2, "Col 3", 100)
Define ImgList = ImageList_Create_(16, 16, #ILC_COLOR32 | #ILC_MASK, 0, 10)
SendMessage_(GadgetID(ListIcon), #LVM_SETIMAGELIST, #LVSIL_SMALL, ImgList)
SendMessage_(GadgetID(ListIcon), #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
;For i = 0 To 10
For i = 0 To 100
AddGadgetItem(ListIcon, i, "item" + i + Chr(10) + "subitem" + i)
Next
icon_index = Add_Icon_To_ImageList(ImgList, "shell32.dll", 296)
ListIcon_SetItemImage(ListIcon, 5, 2, icon_index)
ListIcon_SetItemImage(ListIcon, 6, 2, icon_index)
SetListIconLineColors(ListIcon)
; For fixing arrow up/down key bug.
OldWndProc = SetWindowLongPtr_(GadgetID(ListIcon), #GWLP_WNDPROC, @WndProc_ListIcon())
SetWindowCallback(@WndProc())
Repeat
e = WaitWindowEvent()
Until e = #PB_Event_CloseWindow
If you want to change the icon background for the first column as well, modify it like this.
Code: Select all
......
rt\left = #LVIR_BOUNDS
SendMessage_(GadgetID(ListIcon), #LVM_GETITEMRECT, *lvcd\nmcd\dwItemSpec, rt)
rtIcon\left = #LVIR_ICON
SendMessage_(GadgetID(ListIcon), #LVM_GETITEMRECT, *lvcd\nmcd\dwItemSpec, rtIcon)
w = rt\right - rt\left
h = rt\bottom - rt\top
If ItemSelected And GetActiveGadget() = ListIcon
BkColor = GetSysColor_(#COLOR_HIGHLIGHT)
Else
BkColor = GetSysColor_(#COLOR_BTNFACE)
EndIf
hdcMem = CreateCompatibleDC_(*lvcd\nmcd\hdc)
If hdcMem
hBitmap = CreateCompatibleBitmap_(*lvcd\nmcd\hdc, w, h)
If hBitmap
old = SelectObject_(hdcMem, hBitmap)
If *lvcd\nmcd\uItemState & #CDIS_FOCUS
rt\left + rtIcon\right
DrawFocusRect_(*lvcd\nmcd\hdc, rt)
rt\left - rtIcon\right
EndIf
BitBlt_(hdcMem, 0, 0, w, h, *lvcd\nmcd\hdc, rt\left, rt\top, #SRCCOPY)
hBrush = CreateSolidBrush_(BkColor)
If hBrush
FillRect_(*lvcd\nmcd\hdc, rt, hBrush)
DeleteObject_(hBrush)
EndIf
If *lvcd\nmcd\dwItemSpec % 2
TransparentBlt(*lvcd\nmcd\hdc, rt\left, rt\top, w, h, hdcMem, 0, 0, w, h, ListIconBkColor1)
Else
TransparentBlt(*lvcd\nmcd\hdc, rt\left, rt\top, w, h, hdcMem, 0, 0, w, h, ListIconBkColor0)
EndIf
If *lvcd\nmcd\uItemState & #CDIS_FOCUS
DrawFocusRect_(*lvcd\nmcd\hdc, rt)
EndIf
SelectObject_(hdcMem, old)
DeleteObject_(hBitmap)
EndIf
DeleteDC_(hdcMem)
EndIf
......
Edit: Improved code.
Edit2: The code is isolated as much as possible to make it easy to apply. It's easy to modularize, if needed.
Code: Select all
EnableExplicit
#LVBKIF_SOURCE_HBITMAP = 1
#LVBKIF_STYLE_TILE = 16
#OldWndProc$ = "OldWndProc"
#LVBkData$ = "LVBkData"
Structure LVBKIMAGE Align #PB_Structure_AlignC
ulFlags.l
hbm.i
pszImage.s
cchImageMax.l
xOffsetPercent.l
yOffsetPercent.l
EndStructure
Structure STRUC_ListIconBkData
Gadget.i
hHeader.i
iKeyPressed.i
hBrush.i[2]
lColor0.l
lColor1.l
EndStructure
Procedure UpdateListIconBkImage(Gadget)
Protected iResult
Protected iIdxFirst, iPageItems, iItemCount, ItemW, ItemH, AllItemH, hWnd, hBrush, i
Protected hBrushHL, hBrushBk, hdc, hdcDst, hBitmap, w, h, oldBitmap, oldBrush
Protected rt.RECT, lvi.LVBKIMAGE, lHighlightColor.l = -1
Protected *ListData.STRUC_ListIconBkData
hWnd = GadgetID(Gadget)
*ListData = GetProp_(hWnd, #LVBkData$)
If *ListData = 0 : ProcedureReturn 0 : EndIf
GetClientRect_(hWnd, rt)
w = rt\right
h = rt\bottom
iIdxFirst = SendMessage_(hWnd, #LVM_GETTOPINDEX, 0, 0)
iItemCount = SendMessage_(hWnd, #LVM_GETITEMCOUNT, 0, 0)
iPageItems = SendMessage_(hWnd, #LVM_GETCOUNTPERPAGE, 0, 0)
rt\left = #LVIR_BOUNDS
SendMessage_(hWnd, #LVM_GETITEMRECT, 0, rt)
ItemW = rt\right - rt\left
ItemH = rt\bottom - rt\top
AllItemH = iItemCount * ItemH
If GetActiveGadget() = Gadget
lHighlightColor = GetSysColor_(#COLOR_HIGHLIGHT)
ElseIf GetWindowLongPtr_(hWnd, #GWL_STYLE) & #LVS_SHOWSELALWAYS ;= #LVS_SHOWSELALWAYS
lHighlightColor = GetSysColor_(#COLOR_BTNFACE)
EndIf
If lHighlightColor <> -1
hBrushHL = CreateSolidBrush_(lHighlightColor)
EndIf
hBrush = *ListData\hBrush[iIdxFirst % 2]
hdc = GetDC_(hWnd)
If hdc
hdcDst = CreateCompatibleDC_(hdc)
If hdcDst
hBitmap = CreateCompatibleBitmap_(hdc, w, h)
If hBitmap
oldBitmap = SelectObject_(hdcDst, hBitmap)
; If the client area height is greater than the sum of all item heights,
; fill the client area with the default background color.
If AllItemH < h
hBrushBk = CreateSolidBrush_(GetSysColor_(#COLOR_WINDOW))
If hBrushBk
oldBrush = SelectObject_(hdcDst, hBrushBk)
PatBlt_(hdcDst, 0, 0, w, h, #PATCOPY)
SelectObject_(hdcDst, oldBrush)
DeleteObject_(hBrushBk)
EndIf
h = AllItemH
EndIf
; Fill only up to the area of the visible items with the brush.
oldBrush = SelectObject_(hdcDst, hBrush)
PatBlt_(hdcDst, 0, 0, w, h, #PATCOPY)
If hBrushHL
SelectObject_(hdcDst, hBrushHL)
; If the total number of items is less than what can be shown on the current page, only checks the status of visible items.
If iItemCount < iPageItems
iPageItems = iItemCount
EndIf
; Fills the selected item position with a highlight brush.
For i = 0 To iPageItems
If SendMessage_(hWnd, #LVM_GETITEMSTATE, iIdxFirst + i, #LVIS_SELECTED)
PatBlt_(hdcDst, rt\left, i * ItemH, ItemW, ItemH, #PATCOPY)
EndIf
Next
EndIf
SelectObject_(hdcDst, oldBrush)
SelectObject_(hdcDst, oldBitmap)
lvi\ulFlags = #LVBKIF_SOURCE_HBITMAP | #LVBKIF_STYLE_TILE
lvi\hbm = hBitmap
iResult = SendMessage_(hWnd, #LVM_SETBKIMAGE, 0, lvi)
EndIf
DeleteDC_(hdcDst)
EndIf
ReleaseDC_(hWnd, hdc)
EndIf
If hBrushHL : DeleteObject_(hBrushHL) : EndIf
ProcedureReturn iResult
EndProcedure
; Color1, Color2: RGB Color value
; -1 Keep existing color, or default color(the first time this function is executed)
Procedure SetListIconLineColors(Gadget, Color1.l = #White, Color2.l = $CCCCCC)
Protected iClear, h, rt.RECT, img, hHeader, hWnd, i, *ListData.STRUC_ListIconBkData
Protected Dim Color.l(1)
If GadgetType(Gadget) <> #PB_GadgetType_ListIcon : ProcedureReturn 0 : EndIf
hWnd = GadgetID(Gadget)
*ListData = GetProp_(hWnd, #LVBkData$)
If *ListData = 0
*ListData = AllocateMemory(SizeOf(STRUC_ListIconBkData))
If *ListData
SetProp_(hWnd, #LVBkData$, *ListData)
*ListData\Gadget = Gadget
hHeader = SendMessage_(hWnd, #LVM_GETHEADER, 0, 0)
If hHeader
*ListData\hHeader = hHeader
SetWindowLongPtr_(hHeader, #GWLP_ID, Gadget)
EndIf
If Color1 = -1
*ListData\lColor0 = #White
Else
*ListData\lColor0 = Color1
EndIf
If Color2 = -1
*ListData\lColor1 = $CCCCCC
Else
*ListData\lColor1 = Color2
EndIf
EndIf
EndIf
If *ListData = 0 : ProcedureReturn 0 : EndIf
If Color1 = -1
Color(0) = *ListData\lColor0
Else
Color(0) = Color1
EndIf
If Color2 = -1
Color(1) = *ListData\lColor1
Else
Color(1) = Color2
EndIf
If CountGadgetItems(Gadget) = 0
AddGadgetItem(Gadget, -1, "test")
iClear = 1
EndIf
rt\left = #LVIR_BOUNDS
SendMessage_(hWnd, #LVM_GETITEMRECT, 0, rt)
h = rt\bottom - rt\top
For i = 0 To 1
img = CreateImage(#PB_Any, 200, h * 2, 24, Color(i))
If img
If StartDrawing(ImageOutput(img))
Box(0, h, 200, h, Color(i ! 1))
StopDrawing()
If *ListData\hBrush[i] : DeleteObject_(*ListData\hBrush[i]) : EndIf
*ListData\hBrush[i] = CreatePatternBrush_(ImageID(img))
EndIf
FreeImage(img)
EndIf
Next
If iClear : ClearGadgetItems(Gadget) : EndIf
ProcedureReturn UpdateListIconBkImage(Gadget)
EndProcedure
;Note: The gadget number must not be zero.
Procedure WndProc_ListIcon(hWnd, Message, wParam, lParam)
Protected OldWndProc = GetProp_(hWnd, #OldWndProc$)
Protected iIdxFirst, iPageItems, *ListData.STRUC_ListIconBkData
Select Message
Case #WM_PAINT, #WM_KILLFOCUS
iIdxFirst = SendMessage_(hWnd, #LVM_GETTOPINDEX, 0, 0)
iPageItems = SendMessage_(hWnd, #LVM_GETCOUNTPERPAGE, 0, 0)
SendMessage_(hWnd, #LVM_REDRAWITEMS, iIdxFirst, iIdxFirst + iPageItems)
Case #WM_KEYDOWN
Select wParam
Case #VK_UP, #VK_DOWN, #VK_PRIOR, #VK_NEXT, #VK_HOME, #VK_END
*ListData = GetProp_(hWnd, #LVBkData$)
If *ListData
*ListData\iKeyPressed = 1
EndIf
EndSelect
Case #WM_KEYUP
*ListData = GetProp_(hWnd, #LVBkData$)
If *ListData
*ListData\iKeyPressed = 0
UpdateListIconBkImage(*ListData\Gadget)
EndIf
Case #WM_NCDESTROY
*ListData = GetProp_(hWnd, #LVBkData$)
If *ListData : FreeMemory(*ListData) : EndIf
RemoveProp_(hWnd, #LVBkData$)
RemoveProp_(hWnd, #OldWndProc$)
EndSelect
ProcedureReturn CallWindowProc_(OldWndProc, hWnd, Message, wParam, lParam)
EndProcedure
Procedure ProcessListIconNotification(hWnd, wParam, *lParam.NMHDR)
Protected *lvcd.NMLVCUSTOMDRAW, *hdr.NMHEADER
Protected Gadget, iSetBk, iColunmWidth, StopPaint, hListIcon
Protected *ListData.STRUC_ListIconBkData
Static iPrevColunmWidth
If *lParam = 0 : ProcedureReturn 0 : EndIf
Gadget = GetWindowLongPtr_(*lParam\hwndFrom, #GWLP_ID)
If Gadget = 0 : ProcedureReturn 0 : EndIf
hListIcon = GadgetID(Gadget)
*ListData = GetProp_(hListIcon, #LVBkData$)
If *ListData = 0 : ProcedureReturn 0 : EndIf
If *lParam\hwndFrom = *ListData\hHeader
; Notification from a header control.
; To fix an issue with the icon background of subitems when resizing the headers.
*hdr = *lParam
Select *lParam\code
Case #HDN_ENDTRACK
StopPaint = 0
iPrevColunmWidth = -1000
RedrawWindow_(hListIcon, 0, 0, #RDW_INVALIDATE | #RDW_UPDATENOW)
Case #HDN_BEGINTRACK
iPrevColunmWidth = -1000
Case #HDN_ITEMCHANGED
iColunmWidth = GetGadgetItemAttribute(Gadget, 0, #PB_ListIcon_ColumnWidth, *hdr\iItem)
If iPrevColunmWidth <> iColunmWidth
iPrevColunmWidth = iColunmWidth
StopPaint = 1
iSetBk = 1
EndIf
EndSelect
ElseIf *lParam\hwndFrom = hListIcon
; Notification from a ListIcon gadget.
; To fix issues when scrolling through gadget items.
Select *lParam\code
Case #NM_CUSTOMDRAW
*lvcd = *lParam
If (*ListData\iKeyPressed And *lvcd\nmcd\uItemState & #CDIS_FOCUS) ;Or GetGadgetItemState(Gadget, *lvcd\nmcd\dwItemSpec) & #PB_ListIcon_Selected
iSetBk = 1
Else
ProcedureReturn 0
EndIf
Case #LVN_BEGINSCROLL;, #LVN_ITEMCHANGING
LockWindowUpdate_(hListIcon)
Case #LVN_ENDSCROLL, #NM_SETFOCUS, #LVN_ITEMCHANGED, #NM_KILLFOCUS ;,#LVN_ITEMCHANGING
iSetBk = 1
EndSelect
EndIf
If iSetBk
UpdateListIconBkImage(Gadget)
LockWindowUpdate_(0)
; To fix flickering when resizing the headers.
If StopPaint
ValidateRect_(hListIcon, 0)
EndIf
EndIf
ProcedureReturn 1
EndProcedure
;- Example
Procedure WndProc(hWnd, Message, wParam, lParam)
Protected iResult = #PB_ProcessPureBasicEvents
If Message = #WM_NOTIFY
If lParam
ProcessListIconNotification(hWnd, wParam, lParam)
EndIf
EndIf
ProcedureReturn iResult
EndProcedure
Procedure Add_Icon_To_ImageList(ImgList, DLL_Path.s, index)
Protected hIcon, img_index = -1
hIcon = ExtractIcon_(#Null, DLL_Path, index)
If hIcon
img_index = ImageList_AddIcon_(ImgList, hIcon)
DestroyIcon_(hIcon)
Else
ProcedureReturn -1
EndIf
ProcedureReturn img_index
EndProcedure
Procedure ListIcon_SetItemImage(tempListIconGadget, index_item.w, index_subitem.w, index_image.w)
Protected itemLV.LVITEM ; tagLVITEM
itemLV\mask = #LVIF_IMAGE
itemLV\iItem = index_item
itemLV\iSubItem = index_subitem
itemLV\iImage = index_image
If Not SendMessage_(GadgetID(tempListIconGadget), #LVM_SETITEM, 0, @itemLV)
Debug "#LVM_SETITEM error"
EndIf
EndProcedure
;Note: The gadget number must not be zero.
#ListIcon0 = 2
#ListIcon1 = 3
#ListIcon2 = 4
Procedure Event_ResizeWnd()
Protected Window = EventWindow()
Protected w = (WindowWidth(Window) - 40) / 3
Protected h = WindowHeight(Window) - 50
ResizeGadget(#ListIcon0, 10, 40, w, h)
ResizeGadget(#ListIcon1, w + 20, 40, w, h)
ResizeGadget(#ListIcon2, w * 2 + 30, 40, w, h)
UpdateListIconBkImage(#ListIcon0)
UpdateListIconBkImage(#ListIcon1)
EndProcedure
Define w, h, i, g, e, Result, Font
Define Window = OpenWindow(#PB_Any, 0, 0, 900, 600, "Image transparency", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
; To fix some drawing issues.
SmartWindowRefresh(Window, 1)
ButtonGadget(0, 10, 5, 100, 25, "Font 1")
ButtonGadget(1, 120, 5, 100, 25, "Font 2")
w = (WindowWidth(Window) - 40) / 3
h = WindowHeight(Window) - 50
ListIconGadget(#ListIcon0, 10, 40, w, h, "Col 1", 100, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_MultiSelect)
ListIconGadget(#ListIcon1, w + 20, 40, w, h, "Col 1", 100, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
ListIconGadget(#ListIcon2, w * 2 + 30, 40, w, h, "Plain ListIcon", 100, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_MultiSelect)
For g = #ListIcon0 To #ListIcon2
AddGadgetColumn(g, 1, "Col 2", 100)
AddGadgetColumn(g, 2, "Col 3", 100)
Define ImgList = ImageList_Create_(16, 16, #ILC_COLOR32 | #ILC_MASK, 0, 10)
SendMessage_(GadgetID(g), #LVM_SETIMAGELIST, #LVSIL_SMALL, ImgList)
SendMessage_(GadgetID(g), #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
;For i = 0 To 26
For i = 0 To 100
AddGadgetItem(g, i, "item" + i + Chr(10) + "subitem" + i)
Next
Define icon_index = Add_Icon_To_ImageList(ImgList, "shell32.dll", 296)
ListIcon_SetItemImage(g, 5, 2, icon_index)
ListIcon_SetItemImage(g, 6, 2, icon_index)
; Set the text color.
SetGadgetItemColor(g, 7, #PB_Gadget_FrontColor, #Red, #PB_All)
SetGadgetItemColor(g, 8, #PB_Gadget_FrontColor, #Green, #PB_All)
; No background color of an item can be set.
SetGadgetItemColor(g, 0, #PB_Gadget_BackColor, #Yellow, #PB_All)
If g <> #ListIcon2
SetListIconLineColors(g, #White, RGB(Random(255), Random(255), Random(255)))
; To fix some drawing issues.
SetProp_(GadgetID(g), #OldWndProc$, SetWindowLongPtr_(GadgetID(g), #GWLP_WNDPROC, @WndProc_ListIcon()))
EndIf
Next
SetWindowCallback(@WndProc())
BindEvent(#PB_Event_SizeWindow, @Event_ResizeWnd(), Window)
Repeat
e = WaitWindowEvent()
If e = #PB_Event_Gadget And EventType() = #PB_EventType_LeftClick
g = EventGadget()
If GadgetType(g) = #PB_GadgetType_Button
Result = FontRequester("Arial", 12, 0)
If Result
Font = LoadFont(#PB_Any, SelectedFontName(), SelectedFontSize(), SelectedFontStyle())
If Font
Select g
Case 0
SetGadgetFont(#ListIcon0, FontID(Font))
SetListIconLineColors(#ListIcon0, -1, -1)
Case 1
SetGadgetFont(#ListIcon1, FontID(Font))
SetListIconLineColors(#ListIcon1, -1, -1)
EndSelect
EndIf
EndIf
EndIf
EndIf
Until e = #PB_Event_CloseWindow
FreeFont(#PB_All)
