PureBasic Forums - English

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

Right the following seems to fix the problem :

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

;Here we add some text to the underlying cell text to store the color info.
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) 
            ;... Define text and background colors for column 0 and set Drawtext_() flags 
            lvFlags =  #DT_END_ELLIPSIS | #DT_WORDBREAK;| #DT_MODIFYSTRING 
            ;... 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_NOCLIP|#DT_END_ELLIPSIS) 
              subItemRect\left + GetCharWidth(*nmhdr\hwndFrom, c$) 
              If subItemRect\left >= subItemRect\right-4
                Break
              EndIf
            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", 50, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection) 
  AddGadgetColumn(0, 1, "Column 1", 50) 
  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, 1, 0, 16, #Green) 
  SetColor(0, 0, 2, 0, 14, #Red) 
  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

Now for the sparkie challenge!

Posted: **Sun Oct 14, 2007 1:04 pm**

Thanks for the bug spot srod.

I edited my original code and used #DT_WORD_ELLIPSIS | #DT_NOCLIP for the DrawText flags and it seems to work here, and no need for the If subItemRect\left >= subItemRect\right-4 that you added. Can you confirm?

As for the challenge, the clock is ticking my friend

Posted: **Sun Oct 14, 2007 1:08 pm**

Sorry sparks, still problems with that. Set column 0 to have size 50 and then move the mouse over the listicon to see the problem.

As for your clock, you can bury that in the back yard!

Code: Select all

#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) 
  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) 
  result = #PB_ProcessPureBasicEvents 
  Dim LVColor(0)
  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) 
            text$ = GetGadgetItemText(0, 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(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 
            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, 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", 50, #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

Actually, this still uses your method because to remove the individual character info would slow things down too much.

What I have done, however, is massively reduce the amount of memory being used. I've switched your global array for a local one of dimension equal to the length of the text in the cell being painted. The colour information is embedded within the text of each cell.

Posted: **Sun Oct 14, 2007 1:16 pm**

Very nice srod.

I never would have though of that little trick

I shall now go bury my clock

Posted: **Sun Oct 14, 2007 1:22 pm**

Sparkie wrote:Very nice srod. I never would have though of that little trick

I shall now go bury my clock

Thanks.

I use the same trick with the EsGRID library and button type cells. I add a character which informs if the button is down etc.

After all, when taking charge of all drawing matters etc. we can do whatever we like with the text.

Posted: **Sun Oct 14, 2007 1:24 pm**

I still like your approach better than mine srod, but could you go back and check mine one more time for that draw bug. I removed the #DT_NOCLIP flag and it works fine here (I think).

Posted: **Sun Oct 14, 2007 1:30 pm**

Confirmed. Seems to work fine now. I thought you meant to keep the #DT_NOCLIP flag which did puzzle me a little!

Still I think you should alter the bounds of the rectangle a little because things look a bit odd with no left\right margins within the individual cells etc.
Indeed, adding

Code: Select all

InflateRect_(subItemRect,-2,0)

does make it look quite a bit better

In fact I'll add this to my code as well.

Posted: **Sun Oct 14, 2007 1:34 pm**

Thanks for the input and the code improvements srod

Posted: **Sun Oct 14, 2007 1:36 pm**

No probs, I enjoyed it.

PureBasic Forums - English

Listicon Gadget bitmap ?