PureBasic Forums - English

Posted: **Tue May 06, 2003 6:15 pm**

I am trying to create something similar to the "FlexGrid" controls in Visual Basic. I need to create a grid showing the time used for appointments, so it should have the days along the top and the time along the left side. If an appointment is scheduled, the color of the appropriate "cells" would be changed.

I am using the ListIconGadget in the Report mode. There are two features that I haven't been able to figure out:

The grid control has row headers on the left side as well as column headers. Is there any way to do this with the ListIconGadget? If not, any suggestions for accomplishing something similar by adding another control?

The grid control allows the background color of each "cell" (row and column intersection) to be set individually. I can change the background color of the entire ListIconGadget, but can this be done for separate "cells"? Would a callback routine help?

I have searched the MSDN site and I'm getting the idea that the Windows ListView control isn't really suited for this purpose. I thought I'd present this to the experts here before giving up or using a different (worse) display method.

Thanks,
Eric

Posted: **Tue May 06, 2003 7:43 pm**

>>> The grid control allows the background color of each "cell" (row and column intersection) to be set individually. I can change the background color of the entire ListIconGadget, but can this be done for separate "cells"? Would a callback routine help?

Hi EBS,
The listview must have LVS_OWNERDRAWFIXED style
Here is LVS_OWNERDRAWFIXED style small explanation from MSDK.

LVS_OWNERDRAWFIXED :
The owner window can paint items in report view. The list-view control sends a WM_DRAWITEM message to paint each item; it does not send separate messages for each subitem. The iItemData member of the DRAWITEMSTRUCT structure contains the item data for the specified list-view item.

You could take a look here (in C)

http://codeguru.earthweb.com/listview/row_color.shtml

May be some guys here have already done this in PB.

Denis

Posted: **Tue May 06, 2003 11:06 pm**

Denis,

Thanks for the pointer (pun intended

) to the C code. I followed the message thread and found a really good example that I converted to PureBasic. The code below lets you set the text and background colors for each row individually. I haven't been able to make it work for each "cell" yet, but I'm going to keep trying!

Regards,
Eric

Code: Select all

Structure NMCUSTOMDRAW
    hdr.NMHDR
    dwDrawStage.l
    hdc.l
    rc.RECT
    dwItemSpec.l
    uItemState.l
    lItemlParam.l
EndStructure

Structure NMLVCUSTOMDRAW
    nmcd.NMCUSTOMDRAW
    clrText.l
    clrTextBk.l
    iSubItem.l
    dwItemType.l

    clrFace.l
    iIconEffect.l
    iIconPhase.l
    iPartId.l
    iStateId.l
    
    rcText.RECT
    uAlign.l
EndStructure

#NM_CUSTOMDRAW = #NM_FIRST - 12

#CDDS_ITEM = $10000
#CDDS_PREPAINT = $1
#CDDS_ITEMPREPAINT = #CDDS_ITEM | #CDDS_PREPAINT
#CDRF_DODEFAULT = $0
#CDRF_NOTIFYITEMDRAW = $20

Global ListGadget.l

; window callback routine to color listview rows
Declare.l NotifyCallback(WindowID.l, Message.l, wParam.l, lParam.l)

hWnd.l = OpenWindow(0, 0, 0, 356, 197, #PB_Window_ScreenCentered | #PB_Window_SystemMenu, "Color List View Rows")
CreateGadgetList(hWnd)

; create list with seven columns
ListGadget = ListIconGadget(1, 10, 10, 336, 177,"", 70, #PB_ListIcon_GridLines) 
AddGadgetColumn(1, 1, "Sun", 35) 
AddGadgetColumn(1, 2, "Mon", 35) 
AddGadgetColumn(1, 3, "Tue", 35) 
AddGadgetColumn(1, 4, "Wed", 35) 
AddGadgetColumn(1, 5, "Thu", 35) 
AddGadgetColumn(1, 6, " Fri", 35) 
AddGadgetColumn(1, 7, "Sat", 35) 

; add some rows
AddGadgetItem(1, -1, "  9:00 am")
AddGadgetItem(1, -1, "  9:30 am")
AddGadgetItem(1, -1, "10:00 am")
AddGadgetItem(1, -1, "10:30 am")
AddGadgetItem(1, -1, "11:00 am")
AddGadgetItem(1, -1, "11:30 am")
AddGadgetItem(1, -1, "12:00 pm")
AddGadgetItem(1, -1, "12:30 pm")
AddGadgetItem(1, -1, "  1:00 pm")
AddGadgetItem(1, -1, "  1:30 pm")
AddGadgetItem(1, -1, "  2:00 pm")
AddGadgetItem(1, -1, "  2:30 pm")
AddGadgetItem(1, -1, "  3:00 pm")
AddGadgetItem(1, -1, "  3:30 pm")
AddGadgetItem(1, -1, "  4:00 pm")
AddGadgetItem(1, -1, "  4:30 pm")
AddGadgetItem(1, -1, "  5:00 pm")

; set callback routine
SetWindowCallback(@NotifyCallback())

Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow

End

; window callback routine to color listview rows
Procedure.l NotifyCallback(WindowID.l, Message.l, wParam.l, lParam.l)
  ; process NOTIFY message only
  If Message = #WM_NOTIFY
    ; set stucture pointer
    *LVCDHeader.NMLVCUSTOMDRAW = lParam
    ; CUSTOMDRAW message from desired gadget?
    If *LVCDHeader\nmcd\hdr\hWndFrom = ListGadget And *LVCDHeader\nmcd\hdr\code = #NM_CUSTOMDRAW
      Select *LVCDHeader\nmcd\dwDrawStage
        Case #CDDS_PREPAINT
          ProcedureReturn #CDRF_NOTIFYITEMDRAW
        Case #CDDS_ITEMPREPAINT
          ; simple example - change text and background colors every other row
          Row.l = *LVCDHeader\nmcd\dwItemSpec
          If (Row/2) * 2 = Row
            *LVCDHeader\clrText = RGB(255, 0, 0)
            *LVCDHeader\clrTextBk = RGB(255, 255, 223)
          Else
            *LVCDHeader\clrText = RGB(0, 0, 255)
            *LVCDHeader\clrTextBk = RGB(208, 208, 176)
          EndIf
          ProcedureReturn #CDRF_DODEFAULT
      EndSelect
    EndIf
  Else
    ProcedureReturn #PB_ProcessPureBasicEvents
  EndIf
EndProcedure

Posted: **Wed May 07, 2003 8:29 am**

Fantactics ebs,

Thanks

Manolo

Posted: **Wed May 07, 2003 1:47 pm**

Hi EBS,

nice work!

here is another good exemple with good explanations.
http://www.codeproject.com/listctrl/lvcustomdraw.asp

It will answer to your problem.

Denis

Posted: **Wed May 07, 2003 2:14 pm**

Denis,

Thank you for the latest article. I should have my changes done shortly. Hey, don't you think we make a great team? You find the C code, and I'll convert it!

Regards,
Eric

Posted: **Wed May 07, 2003 2:47 pm**

>>> Hey, don't you think we make a great team? You find the C code, and I'll convert it!

Yes Ebs, but you made the most important work.

Because i was working a lot with Listicon, i get some problems and i try to find answers on the web and with MSDK. Each time i found a site about Listicon wich is interessing Thing, i keep the adress.

Regards,

Denis

Posted: **Wed May 07, 2003 4:35 pm**

I posted my latest revision in the thread in the "Tips and Tricks" forum. It shows how to set the text/background colors and font for each "cell" in a ListIconGadget (ListView control). It's almost ready to be used as a grid control replacement. Now all I need is a way to put row headers down the left side - Denis???

Posted: **Wed May 07, 2003 6:48 pm**

>>> Now all I need is a way to put row headers down the left side - Denis???

I'm sorry Ebs, but since the beginning, I did not answer because I don't really understand what you want to do.

Denis

Posted: **Thu May 08, 2003 8:12 pm**

Hi,

I've played with your code (hope you don't mind), and I've come to this excel-style thing. Still without buttons, but I think it won't be difficult once I've managed to put an edit control as a LV child and move it when scrolling. To check functionality, click, doubleclick and edit anywhere:

Code: Select all

Structure NMCUSTOMDRAW
    hdr.NMHDR
    dwDrawStage.l
    hdc.l
    rc.RECT
    dwItemSpec.l
    uItemState.l
    lItemlParam.l
EndStructure

Structure NMLVCUSTOMDRAW
    nmcd.NMCUSTOMDRAW
    clrText.l
    clrTextBk.l
    iSubItem.l
    dwItemType.l
    clrFace.l
    iIconEffect.l
    iIconPhase.l
    iPartId.l
    iStateId.l
    rcText.RECT
    uAlign.l
EndStructure

#NM_CUSTOMDRAW = #NM_FIRST-12 

#CDDS_ITEM = $10000
#CDDS_SUBITEM = $20000
#CDDS_PREPAINT = $1
#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT
#CDRF_DODEFAULT = $0
#CDRF_NEWFONT = $2
#CDRF_NOTIFYITEMDRAW = $20
#CDRF_NOTIFYSUBITEMDRAW = $20

Structure LVHITTESTINFO
  pt.POINT
  flags.l
  iItem.l
  iSubItem.l
EndStructure

#LVM_SUBITEMHITTEST = #LVM_FIRST+57
#LVM_GETSUBITEMRECT = #LVM_FIRST+56

Global ListGadget, OldLViewProc, OldEditProc, hEdit, rct.RECT, CellSelectOn, CurItem, CurSubItem, CurSelItem, CurSelSubItem

Declare EditProc(hWnd, uMsg, wParam, lParam)
Declare LViewProc(hWnd, uMsg, wParam, lParam)
Declare WndProc(hWnd, uMsg, wParam, lParam) 
Declare KillFocus()
Declare DrawRectangle(hWnd, *rc.RECT)

#CCM_SETVERSION = #CCM_FIRST+7

Global FontReg, FontBold
FontReg = LoadFont(1, "Tahoma", 9) 
FontBold = LoadFont(2, "Tahoma", 9, #PB_Font_Bold) 

If OpenWindow(0, 0, 0, 400, 260, #PB_Window_ScreenCentered|#PB_Window_SystemMenu, "Color List View Rows")=0:End:EndIf
If CreateGadgetList(WindowID())=0:End:EndIf

ListGadget = ListIconGadget(1, 10, 10, 380, 240, "", 70, #PB_ListIcon_GridLines|#LVS_NOSORTHEADER)

SendMessage_(ListGadget, #CCM_SETVERSION, 5, 0)

AddGadgetColumn(1, 1, "Sun", 35)
AddGadgetColumn(1, 2, "Mon", 35)
AddGadgetColumn(1, 3, "Tue", 35)
AddGadgetColumn(1, 4, "Wed", 35)
AddGadgetColumn(1, 5, "Thu", 35)
AddGadgetColumn(1, 6, "Fri", 35)
AddGadgetColumn(1, 7, "Sat", 35)

For i=18 To 34
  hour12 = i
  If hour12>25
    hour12-24
    Hour$ = " pm"
  Else
    Hour$ = " am"
  EndIf
  If hour12&1
    Hour$=LSet(Str(hour12/2)+":30"+Hour$, 9, " ")
  Else
    Hour$=LSet(Str(hour12/2)+":00"+Hour$, 9, " ")
  EndIf
  AddGadgetItem(1, -1, Hour$+Chr(10)+Str(hour12/2)+"1"+Chr(10)+Str(hour12/2)+"2"+Chr(10)+Str(hour12/2)+"3"+Chr(10)+Str(hour12/2)+"4"+Chr(10)+Str(hour12/2)+"5"+Chr(10)+Str(hour12/2)+"6"+Chr(10)+Str(hour12/2)+"7")
Next i

SendMessage_(ListGadget, #LVM_SETBKCOLOR, 0, RGB(255, 255, 223))

CreateGadgetList(ListGadget)
OldLViewProc = SetWindowLong_(ListGadget, #GWL_WNDPROC, @LViewProc())
SetWindowCallback(@WndProc()) 

For i=0 To 7
  SendMessage_(ListGadget, #LVM_SETCOLUMNWIDTH, i, #LVSCW_AUTOSIZE_USEHEADER)
Next i

Repeat 
Until WaitWindowEvent()=#PB_Event_CloseWindow 

End 

Procedure KillFocus()
  If hEdit
    SetGadgetItemText(1, CurItem, GetGadgetText(2), CurSubItem)
    FreeGadget(2)
    hEdit = 0
  EndIf
EndProcedure

Procedure DrawRectangle(hWnd, *rc.RECT)
  hDC = GetDC_(hWnd)
  OldPen = SelectObject_(hDC, GetStockObject_(#BLACK_PEN))
  OldBrush = SelectObject_(hDC, GetStockObject_(#NULL_BRUSH))
  Rectangle_(hDC, *rc\left, *rc\top, *rc\right, *rc\bottom)
  SelectObject_(hDC, OldBrush)
  SelectObject_(hDC, OldPen)
  ReleaseDC_(hWnd, hDC)
EndProcedure

Procedure EditProc(hWnd, uMsg, wParam, lParam)
  result = 0
  Select uMsg
    Case #WM_KEYDOWN
      result = CallWindowProc_(OldEditProc, hWnd, uMsg, wParam, lParam)
      If wParam=#VK_RETURN
        KillFocus()
      EndIf
    Default
      result = CallWindowProc_(OldEditProc, hWnd, uMsg, wParam, lParam)
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure LViewProc(hWnd, uMsg, wParam, lParam)
  result = 0
  Select uMsg
    Case #WM_LBUTTONDBLCLK
      If hWnd<>hEdit
        KillFocus()
        pInfo.LVHITTESTINFO
        pInfo\pt\x = LoWord(lParam)
        pInfo\pt\y = HiWord(lParam)
        SendMessage_(hWnd, #LVM_SUBITEMHITTEST, 0, pInfo)
        rc.RECT
        rc\top = pInfo\iSubItem
        rc\left = #LVIR_BOUNDS
        SendMessage_(hWnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc)
        If hEdit=0
          UseGadgetList(hWnd)
          CurItem = pInfo\iItem
          CurSubItem = pInfo\iSubItem
          Text$ = GetGadgetItemText(1, CurItem, CurSubItem)
          If CurSubItem=0
            rc\right = rc\left+SendMessage_(hWnd, #LVM_GETCOLUMNWIDTH, 0, 0)
          EndIf
          hEdit = StringGadget(2, rc\left+1, rc\top, rc\right-rc\left-1, rc\bottom-rc\top-1, Text$, #PB_String_BorderLess)
          If CurSubItem=0
            SendMessage_(hEdit, #WM_SETFONT, FontBold, #TRUE)
          Else
            SendMessage_(hEdit, #WM_SETFONT, FontReg, #TRUE)
          EndIf
          OldEditProc = SetWindowLong_(hEdit, #GWL_WNDPROC, @EditProc())
          SetFocus_(hEdit)
        EndIf
      Else
        result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam)
      EndIf
    Case #WM_LBUTTONDOWN
      If hWnd<>hEdit
        KillFocus()
        pInfo.LVHITTESTINFO
        pInfo\pt\x = LoWord(lParam)
        pInfo\pt\y = HiWord(lParam)
        SendMessage_(hWnd, #LVM_SUBITEMHITTEST, 0, pInfo)
        rc.RECT
        rc\top = pInfo\iSubItem
        rc\left = #LVIR_BOUNDS
        SendMessage_(hWnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc)
        rc\left+1
        rc\bottom-1
        If CellSelectOn
          InvalidateRect_(hWnd, rct, #TRUE)
        EndIf
        CellSelectOn = 1
        CurSelItem = pInfo\iItem
        CurSelSubItem = pInfo\iSubItem
        If CurSelSubItem=0
          rc\right = rc\left+SendMessage_(hWnd, #LVM_GETCOLUMNWIDTH, 0, 0)
        EndIf
        DrawRectangle(hWnd, rc)
        CopyMemory(rc, rct, SizeOf(RECT))
      Else
        SetFocus_(hEdit)
        result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam)
      EndIf
    Case #WM_CTLCOLOREDIT
      If GetFocus_()=lParam
        SetBkMode_(wParam, #TRANSPARENT)
        If CurItem&1=0
          TextBkColor = RGB(255, 255, 223)
          If CurSubItem=3
            TextColor = RGB(255, 0, 0)
          EndIf
        Else
          TextBkColor = RGB(208, 208, 176)
          If CurSubItem=3
            TextColor = RGB(0, 0, 255)
          EndIf
        EndIf
        SetTextColor_(wParam, TextColor)
        result = CreateSolidBrush_(TextBkColor)
      Else
        result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam)
      EndIf
    Case #WM_VSCROLL
      result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam)
      rc.RECT
      TopVisibleItem = SendMessage_(hWnd, #LVM_GETTOPINDEX, 0, 0)
      If CellSelectOn
        rc\top = CurSelSubItem
        rc\left = #LVIR_BOUNDS
        SendMessage_(hWnd, #LVM_GETSUBITEMRECT, CurSelItem, rc)
        rct\top = rc\top
        rct\bottom = rc\bottom-1
        If TopVisibleItem<=CurSelItem
          DrawRectangle(hWnd, rct)
        EndIf
      EndIf
      If hEdit
        If TopVisibleItem<=CurItem
          ResizeGadget(2, -1, rc\top, -1, -1)
          HideGadget(2, #FALSE)
          RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE)
        Else
          HideGadget(2, #TRUE)
        EndIf
        SetFocus_(hEdit)
      EndIf
    Case #WM_HSCROLL
      result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam)
      rc.RECT
      TopVisibleItem = SendMessage_(hWnd, #LVM_GETTOPINDEX, 0, 0)
      If CellSelectOn
        rc\top = CurSelSubItem
        rc\left = #LVIR_BOUNDS
        SendMessage_(hWnd, #LVM_GETSUBITEMRECT, CurSelItem, rc)
        rct\left = rc\left+1
        rct\right = rc\right
        If TopVisibleItem<=CurSelItem
          DrawRectangle(hWnd, rct)
        EndIf
      EndIf
      If hEdit
        If TopVisibleItem<=CurItem
          ResizeGadget(2, rc\left, -1, -1, -1)
          HideGadget(2, #FALSE)
          RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE)
        Else
          HideGadget(2, #TRUE)
        EndIf
        SetFocus_(hEdit)
      EndIf
    Default
      result = CallWindowProc_(OldLViewProc, hWnd, uMsg, wParam, lParam)
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure WndProc(hWnd, uMsg, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
  Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lParam
      Select *pnmh\code
        Case #NM_CUSTOMDRAW
          *LVCDHeader.NMLVCUSTOMDRAW = lParam
          If *LVCDHeader\nmcd\hdr\hWndFrom=ListGadget
            Select *LVCDHeader\nmcd\dwDrawStage 
              Case #CDDS_PREPAINT
                result = #CDRF_NOTIFYITEMDRAW
              Case #CDDS_ITEMPREPAINT
                result = #CDRF_NOTIFYSUBITEMDRAW
              Case #CDDS_SUBITEMPREPAINT
                Row = *LVCDHeader\nmcd\dwItemSpec
                Col = *LVCDHeader\iSubItem
                If Col=0
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontBold)
                Else
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontReg)
                EndIf
                If Row&1=0
                  *LVCDHeader\clrTextBk = RGB(255, 255, 223)
                  If Col=3
                    *LVCDHeader\clrText = RGB(255, 0, 0)
                  Else
                    *LVCDHeader\clrText = RGB(0, 0, 0)
                  EndIf
                Else
                  *LVCDHeader\clrTextBk = RGB(208, 208, 176)
                  If Col=3
                    *LVCDHeader\clrText = RGB(0, 0, 255)
                  Else
                    *LVCDHeader\clrText = RGB(0, 0, 0)
                  EndIf
                EndIf
                result = #CDRF_NEWFONT
            EndSelect
          EndIf
      EndSelect
  EndSelect
  ProcedureReturn result
EndProcedure

Posted: **Thu May 08, 2003 8:55 pm**

El_Choni,

I've played with your code (hope you don't mind)...

How dare you! 8O

Why, I have a good mind to...

Seriously, that's pretty cool! What's interesting is how we are thinking alike. I just finished figuring out how to use the LVM_SUBITEMHITTEST message to determine which row and column were clicked on.

My only suggestion: it might be easier to tell which cell is being edited if you remove the WM_CTLCOLOREDIT code. That way, the edit control background will be white (or whatever the window color is).

When you get the formulas working, let me know!

Eric

Posted: **Thu May 08, 2003 9:02 pm**

Missing:

Code: Select all

Procedure LoWord(value)
  ProcedureReturn value & $FFFF
EndProcedure

Procedure HiWord(value)
  ProcedureReturn value >> 16 & $FFFF
EndProcedure

Posted: **Thu May 08, 2003 9:31 pm**

Danilo,

They're not in the documentation, but the HiWord() and LoWord() commands must be present. The syntax highlighting correctly capitalizes them and the program compiles and runs correctly. Are you using version 3.62?

Eric

Posted: **Thu May 08, 2003 9:54 pm**

ebs wrote:Danilo,

They're not in the documentation, but the HiWord() and LoWord() commands must be present. The syntax highlighting correctly capitalizes them and the program compiles and runs correctly. Are you using version 3.62?
Eric

A better question to ask is -What 3rd party library are you using?

Posted: **Thu May 08, 2003 10:02 pm**

Danilo,

Ah, that is a better question!
Answer: dnMisc library from the PB Resources site.

Eric

PureBasic Forums - English

Help Emulating Windows Grid Control

Help Emulating Windows Grid Control