PureBasic Forums - English

Posted: **Sat Oct 13, 2007 2:52 pm**

> @PB: I'll redo the code properly and post when it's done

Thanks, Sparkie.

SRod's code seems to do it nicely, so thanks to you too, mate.

Ideally, I'm looking for a way to color any part of an item in any column.
So something like: SetColor(gad,column,item,startpos,endpos,color).

It's a tall order but I'm sure I can work it out from SRod's example; or
if you do it I'm sure I can click a PayPal donation button for you.

Posted: **Sat Oct 13, 2007 2:53 pm**

Sparks, I've been playing around a bit more and am puzzled why you add the value of *lvCD\iSubItem to each characters spacing? This puts it out of whack with the default spacing employed by windows?

Remove this and you can mix #CDRF_SKIPDEFAULT with #CDRF_DODEFAULT and get Windows to do some of the work :

Code: Select all

Procedure GetCharWidth(gad,c$) 
  ProcedureReturn SendMessage_(gad,#LVM_GETSTRINGWIDTH,0,@c$) 
EndProcedure 

Procedure WinCallback(hwnd,msg,wParam,lParam) 
  result=#PB_ProcessPureBasicEvents 
  Select msg 
    Case #WM_NOTIFY 
      *nmhdr.NMHDR=lParam 
      If *nmhdr\code=#NM_CUSTOMDRAW And *nmhdr\hwndFrom=GadgetID(0) 
        *lvCD.NMLVCUSTOMDRAW=lParam 
        Select *lvCD\nmcd\dwDrawStage 
          Case #CDDS_ITEMPREPAINT 
            result=#CDRF_NOTIFYSUBITEMDRAW 
          Case #CDDS_ITEMPREPAINT|#CDDS_SUBITEM 
            result=#CDRF_SKIPDEFAULT 
            If *lvCD\nmcd\dwItemSpec>-1 And *lvCD\iSubItem>-1 
              If *lvCD\nmcd\dwItemSpec <> GetGadgetState(0)
                item$=GetGadgetItemText(0,*lvCD\nmcd\dwItemSpec,*lvCD\iSubItem) 
                subItemRc.RECT\left=#LVIR_LABEL : subItemRc\top=*lvCD\iSubItem 
                SendMessage_(*lvCD\nmcd\hdr\hwndFrom,#LVM_GETSUBITEMRECT,*lvCD\nmcd\dwItemSpec,@subItemRc) 
                FillRect_(*lvCD\nmcd\hdc, subItemRc, GetStockObject_(#WHITE_BRUSH)) 
                If *lvCD\iSubItem = 0
                  subItemRc\left+2
                Else
                  subItemRc\left+6
                EndIf
                For c=1 To Len(item$) 
                  zz=#Black : If (c>7 And c<12) Or (c>16 And c<22) : zz=#Red : EndIf 
                  c$=Mid(item$,c,1) : SetTextColor_(*lvCD\nmcd\hdc,zz) : DrawText_(*lvCD\nmcd\hdc,c$,1,subItemRc,#DT_NOCLIP) 
                  subItemRc\left+GetCharWidth(*nmhdr\hwndFrom,c$)
                Next 
              Else
                result = #CDRF_DODEFAULT
              EndIf
            EndIf 
        EndSelect 
      EndIf 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

If OpenWindow(0,200,200,620,235,"Sparkies Multicolor ListIconGadget",#PB_Window_SystemMenu) And CreateGadgetList(WindowID(0)) 
  SetWindowCallback(@WinCallback()) 
  ListIconGadget(0,5,5,610,195,"Column 0",270,#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_FullRowSelect) 
  AddGadgetColumn(0,1,"ll",110) 
  AddGadgetItem(0,-1,"I want THIS and THIS to be red"+Chr(10)+"Hello") 
  AddGadgetItem(0,-1,"I want THIS and THIS to be red"+Chr(10)+"Hello") 
  AddGadgetItem(0,-1,"I want THIS and THIS to be red"+Chr(10)+"Hello") 
  AddGadgetItem(0,-1,"I want THIS and THIS to be red"+Chr(10)+"Hello") 
  AddGadgetItem(0,-1,"I want THIS and THIS to be red"+Chr(10)+"Hello") 
  AddGadgetItem(0,-1,"I want THIS and THIS to be red"+Chr(10)+"Hello") 
  Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow 
EndIf

Posted: **Sat Oct 13, 2007 2:57 pm**

That was used to increment the spacing in my original code. You are correct in removing it.

Posted: **Sat Oct 13, 2007 3:02 pm**

I figured it was something left over!

Have altered the code above to remove some redundant parts added by myself!

Right, football's about to start and then the rugby follows. No more coding from me today!

Posted: **Sat Oct 13, 2007 8:57 pm**

PB wrote:Ideally, I'm looking for a way to color any part of an item in any column.

Try this PB. My head hurts so you may want to tidy up and optimize this for yourself.

Code: Select all

;...Structure to hold character colors 
Structure LVITEMCOLOR 
  iRow.l 
  iCol.l 
  iStartPos.l 
  iEndPos.l 
  iColor.l 
EndStructure 

;... 9 = rows 0 thru 9 
;... 2 = columns 0 thru 2 
;... 260 = characters 1 thru 260 (0 is a dummy) 
Global Dim LVcolor.LVITEMCOLOR(9, 2, 260) 

;... 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 

Procedure SetColor(gad, row, column, startp, endp, color) 
  LVcolor(row, column, 0)\iRow = row 
  LVcolor(row, column, 0)\iCol = column 
  LVcolor(row, column, 0)\iStartPos = startp 
  LVcolor(row, column, 0)\iEndPos = endp 
  LVcolor(row, column, 0)\iColor = color 
  For i = startp To endp 
    LVcolor(row, column, i)\iColor = color 
  Next 
EndProcedure 

Procedure myWindowCallback(hwnd, msg, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents 
  Select msg 
    Case #WM_NOTIFY 
      *nmhdr.NMHDR = lParam 
      *lvCD.NMLVCUSTOMDRAW = lParam 
      If *lvCD\nmcd\hdr\hwndFrom=GadgetID(0) 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(0), #LVM_GETSUBITEMRECT, thisRow, @subItemRect) 
            subItemText$ = GetGadgetItemText(0, thisRow, thisCol) 
            ;... Paint over unused icon rect 
            If *lvCD\iSubItem = 0 
              subItemRect\left = 0 
            EndIf 
            If GetGadgetState(0) = 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 
            
            ;... 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(thisRow, thisCol, c)\iColor 
                nextColor = LVcolor(thisRow, thisCol, i)\iColor 
                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_WORD_ELLIPSIS) 
              subItemRect\left + GetCharWidth(*nmhdr\hwndFrom, c$) 
            Next c 
            result = #CDRF_SKIPDEFAULT 
        EndSelect 
      EndIf 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

If OpenWindow(0, 0, 0, 480, 260, "Set Margins Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0)) 
  SetWindowCallback(@myWindowCallback()) 
  CreateStatusBar(0, WindowID(0)) 
  ListIconGadget(0, 10, 10, 470, 225, "Column 0", 150, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection) 
  AddGadgetColumn(0, 1, "Column 1", 150) 
  AddGadgetColumn(0, 2, "Column 2", 150) 
  For a=0 To 9 
    addtext$ = "Column 0 item #" + Str(a) + Chr(10) + "Column 1 item #" + Str(a) + Chr(10) + "Column 2 item #" + Str(a) 
    atLen = Len(addtext$) 
    AddGadgetItem(0,-1, addtext$) 
  Next 
  
  SetColor(0, 0, 0, 0, 9, #Cyan) 
  SetColor(0, 0, 0, 10, 16, #Blue) 
  SetColor(0, 0, 1, 0, 16, #Green) 
  SetColor(0, 0, 2, 0, 14, #Red) 
  SetColor(0, 0, 2, 10, 16, #Blue) 
  SetColor(0, 5, 0, 0, 9, #Yellow) 
  SetColor(0, 6, 0, 10, 16, #Blue) 
  SetColor(0, 7, 1, 0, 8, #Red) 
  SetColor(0, 8, 2, 0, 14, #Magenta) 
  SetColor(0, 9, 2, 15, 16, #Blue) 
  
  Repeat 
    event = WaitWindowEvent() 
  Until event = #PB_Event_CloseWindow 
  DeleteObject_(brush\brushSelected) 
  
EndIf 
End

*Edited the code to speed up drawing...and then again to fix the bug found by srod

Posted: **Sat Oct 13, 2007 9:00 pm**

Is it normal that it uses 100% CPU when you resize a column (yes, debugger is off)?

Posted: **Sat Oct 13, 2007 9:04 pm**

Probably normal as DrawText is drawing each individual character as opposed to individual item text.

It uses an average of 60 to 80% cpu for me.

Posted: **Sat Oct 13, 2007 9:43 pm**

Try agian Fluid Byte. I made a change to the code and now I get an average of 30% to 50% CPU usage during column resize.

Posted: **Sat Oct 13, 2007 9:53 pm**

Sparkie wrote:Try agian Fluid Byte. I made a change to the code and now I get an average of 30% to 50% CPU usage during column resize.

Actually I'm a bit fussy if you consider that the PB IDE needs about 40% CPU when resizing.

Anyhow, thanks for the "fix"!

Posted: **Sat Oct 13, 2007 9:56 pm**

You're welcome.

Feel free to optimize even more as you see fit.

Posted: **Sat Oct 13, 2007 10:00 pm**

Very nice sparks.

Posted: **Sat Oct 13, 2007 11:57 pm**

WOW, I'm impressed, Sparkie!

Many, many thanks.

Posted: **Sun Oct 14, 2007 4:07 am**

Thank's guys.

You're welcome PB

I tried using GadgetItemData for storing color info but I just couldn't get it to work properly. I may give it another go when I get a chance.

Wait...srod must have some free time...yep, that's the ticket....let srod do it

Posted: **Sun Oct 14, 2007 11:38 am**

Sparkie wrote:I tried using GadgetItemData for storing color info but I just couldn't get it to work properly. I may give it another go when I get a chance.

Wait...srod must have some free time...yep, that's the ticket....let srod do it

Free time! You must be joking lad.

Still, sounds like a challenge. Have a few things to do first, but then I'll have a look!

Posted: **Sun Oct 14, 2007 12:15 pm**

Sparks there's a bug with your code in that if the original cell text is longer than the width of the cell, it spills into the adjacent cell.

A fix is confuzzled by your second loop being used to speed up the drawing.

PureBasic Forums - English

Listicon Gadget bitmap ?