;Autor: srod ;http://www.purebasic.fr/english/viewtopic.php?p=235655#p235655 EnableExplicit Define a #coloredChars_Delimeter = "{***\" ;... Create brushes for painting item background Structure MYBRUSHES brushDefault.l brushSelected.l EndStructure Global brush.MYBRUSHES brush\brushSelected = CreateSolidBrush_(RGB(255, 255, 155)) brush\brushDefault = GetStockObject_(#WHITE_BRUSH) Procedure GetCharWidth(gad, c$) ProcedureReturn SendMessage_(gad, #LVM_GETSTRINGWIDTH, 0, @c$) EndProcedure ;Here we add some text to the underlying cell text to store the color info. Procedure SetColor(gad, row, column, startp, endp, color) Protected text$ text$ = GetGadgetItemText(gad, row, column) ;Now add the new text. text$+#coloredChars_Delimeter+Str(startp)+"\"+Str(endp)+"\"+Str(color) SetGadgetItemText(gad,row,text$,column) EndProcedure Procedure myWindowCallback(hwnd, msg, wParam, lParam) Protected result Protected *nmhdr.NMHDR Protected *lvCD.NMLVCUSTOMDRAW Protected thisRow Protected thisCol Protected subItemRect.RECT Protected text$ Protected pos Protected subItemText$ Protected i Protected j Protected c Protected color Protected c$ Protected thisColor Protected nextColor result = #PB_ProcessPureBasicEvents Dim LVColor(0) Select msg Case #WM_NOTIFY *nmhdr.NMHDR = lParam *lvCD.NMLVCUSTOMDRAW = lParam If *lvCD\nmcd\hdr\hwndFrom=GadgetID(1) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW Select *lvCD\nmcd\dwDrawStage Case #CDDS_PREPAINT result = #CDRF_NOTIFYITEMDRAW Case #CDDS_ITEMPREPAINT result = #CDRF_NOTIFYSUBITEMDRAW; Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM thisRow = *lvCD\nmcd\dwItemSpec thisCol = *lvCD\iSubItem ;... Define rect for text subItemRect.RECT\left = #LVIR_LABEL subItemRect.RECT\top = *lvCD\iSubItem ;... Get the subitem rect SendMessage_(GadgetID(1), #LVM_GETSUBITEMRECT, thisRow, @subItemRect) text$ = GetGadgetItemText(1, thisRow, thisCol) pos = FindString(text$, #coloredChars_Delimeter,1) If pos subItemText$ = Left(text$, pos-1) text$ = Right(text$, Len(text$)-pos+1) Else subItemText$ = text$ text$="" EndIf Dim LVColor(Len(subItemText$)) pos=2 For i = 1 To CountString(text$, #coloredChars_Delimeter) color = Val(StringField(StringField(text$,pos+2,"\"),1,"{")) For j = Val(StringField(text$,pos,"\")) To Val(StringField(text$,pos+1,"\")) LVCOlor(j) = color Next pos+3 Next ;... Paint over unused icon rect If *lvCD\iSubItem = 0 subItemRect\left = 0 EndIf If GetGadgetState(1) = thisRow ;... If item is selected FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushSelected) Else ;... If item is not selected FillRect_(*lvCD\nmcd\hdc, subItemRect, brush\brushDefault) EndIf InflateRect_(subItemRect,-2,0) ;... Here we will paste together the colored characters ;... to form a string. This should speed up the drawing For c = 1 To Len(subItemText$) c$ = Mid(subItemText$, c, 1) For i = c + 1 To Len(subItemText$) thisColor = LVcolor(c) nextColor = LVcolor(i) If thisColor = nextColor c$ + Mid(subItemText$, i, 1) c + 1 Else Break EndIf Next i SetTextColor_(*lvCD\nmcd\hdc, thisColor) DrawText_(*lvCD\nmcd\hdc, c$, Len(c$), subItemRect, #DT_END_ELLIPSIS) subItemRect\left + GetCharWidth(*nmhdr\hwndFrom, c$) Next c result = #CDRF_SKIPDEFAULT EndSelect EndIf EndSelect ProcedureReturn result EndProcedure If OpenWindow(0,0,0,500,250,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) ExplorerListGadget(1,10,10,480,230,"C:\",0) SetColor(1, 1, 0, 2, 3, #Cyan) SetColor(1, 2, 0, 1, 2, #Green) SetColor(1, 3, 0, 2, 4, #Red) SetWindowCallback(@myWindowCallback()) Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow EndIf DeleteObject_(brush\brushSelected) ; IDE Options = PureBasic 5.31 (Windows - x64) ; CursorPosition = 2 ; Folding = - ; EnableUnicode ; EnableXP ; EnableUser ; EnableCompileCount = 0 ; EnableBuildCount = 0