CheckListbox

[localmotion34]

Code updated For 5.20+

just playing around and i got to working on this. its a checklistbox control, complete with subclassing and all. sorta had to do a weird window procedure to get this to work and still be recognized by eventgadgetid(). oh well, have a go at it and post some suggestions. this will end up in my final library of advanced gadgets, even with pushbutton, radiobutton, and bitmap buttons all possible in the listbox.

Code: Select all

Global OriginProc,hbrushDefault,hbrushSelected,hbrushSelectedFocus,OriginProc1
;hbrushDefault = CreateSolidBrush_(#White)
hbrushSelected = CreateSolidBrush_(RGB(200, 255, 200))
hbrushSelectedFocus = CreateSolidBrush_(RGB(0, 0, 80))
#DI_NORMAL = $0003
#ODS_SELECTED=1
#ODS_GRAYED=2
#ODS_DISABLED=4
#ODS_CHECKED=8
#ODS_FOCUS=16
#ODS_DEFAULT= 32
#ODS_COMBOBOXEDIT= 4096
#ODT_STATIC  = 5
#SS_OWNERDRAW=13
#pb_item16=16
#pb_item32=32
#LB_ITEMFROMPOINT=$1A9

Procedure MakeLong1(low, high)
  ProcedureReturn low | high <<16
EndProcedure

Procedure ListboxProc( hwnd, msg,wParam,lParam)
  class.s=Space(255)
  cs=GetClassName_(hwnd,@class,Len(class))
  If class="ListBox"
    Select msg
      Case #WM_LBUTTONDOWN
        If wParam = #MK_LBUTTON
          x.Point
          x\x=lParam&$FFFF
          x\y=(lParam>>16)
          
          ;           xloc.w=lParam&$FFFF
          ;           yloc.w = (lParam>>16)
          t = SendMessage_(hwnd, #LB_ITEMFROMPOINT, 0, MakeLong1(xloc,yloc))
          SendMessage_(hwnd, #LB_GETITEMRECT, t, @rct.RECT)
          rct\left=2
          rct\right=15
          If PtInRect_(rct, PeekQ(x))
            State=SendMessage_(hwnd, #LB_GETITEMDATA, t, 0)
            If State=0
              SendMessage_(hwnd, #LB_SETITEMDATA, t, 1)
              InvalidateRect_(hwnd, rct, 0): UpdateWindow_(hwnd )
            ElseIf State=1
              SendMessage_(hwnd, #LB_SETITEMDATA, t, 0)
              InvalidateRect_(hwnd, rct, 0): UpdateWindow_(hwnd)
            EndIf
          EndIf
        EndIf
    EndSelect
    ProcedureReturn CallWindowProc_(OriginProc1,hwnd,msg,wParam,lParam)
  Else
    Select msg
      Case #WM_DRAWITEM
        textbuffer.s=Space(255)
        *lpdis.DRAWITEMSTRUCT=lParam
        *lptris.DRAWITEMSTRUCT=*lpdis.DRAWITEMSTRUCT
        Select *lpdis\CtlType
          Case #ODT_LISTBOX
            itemHeight=SendMessage_(*lpdis\hwndItem,#LB_GETITEMHEIGHT,0,0)
            Select *lpdis\itemState
              Case #ODS_SELECTED
                dtFlags = #DT_LEFT | #DT_VCENTER
                currentBrush = CreateSolidBrush_(RGB(0, 0, 80))
                currentTextColor = #White
                drawfoc=#False
              Case #ODS_SELECTED | #ODS_FOCUS
                dtFlags = #DT_LEFT | #DT_VCENTER
                currentBrush = hbrushSelectedFocus
                currentTextColor = #White
                drawfoc=#True
              Case 0
                dtFlags = #DT_LEFT | #DT_VCENTER
                currentBrush = #White
                currentTextColor = RGB(0, 0, 0)
                drawfoc=#False
            EndSelect
            SendMessage_(*lpdis\hwndItem,#LB_GETTEXT,*lpdis\itemID,*textbuffer)
            lbText$=textbuffer
            FillRect_(*lpdis\hdc, *lpdis\rcItem, currentBrush)
            If drawfoc=#True
              DrawFocusRect_(*lpdis\hdc, *lpdis\rcItem)
            EndIf
            SetBkMode_(*lpdis\hdc, #TRANSPARENT)
            SetTextColor_(*lpdis\hdc, currentTextColor)
            *lpdis\rcItem\left+itemHeight
            DrawText_(*lpdis\hdc, lbText$, Len(lbText$), *lpdis\rcItem, dtFlags)
            *lpdis\rcItem\left   = 2 : *lpdis\rcItem\right = 15                   
            *lpdis\rcItem\top + 2
            *lpdis\rcItem\bottom - 1
            If SendMessage_(*lpdis\hwndItem, #LB_GETITEMDATA, *lpdis\itemID, 0)=1
              DrawFrameControl_(*lpdis\hdc, *lpdis\rcItem, #DFC_BUTTON, #DFCS_BUTTONCHECK|#DFCS_CHECKED)
            ElseIf SendMessage_(*lpdis\hwndItem, #LB_GETITEMDATA, *lpdis\itemID, 0)=0
              DrawFrameControl_(*lpdis\hdc, *lpdis\rcItem, #DFC_BUTTON, #DFCS_BUTTONCHECK      )
            EndIf                                               
            ProcedureReturn 0
        EndSelect
    EndSelect
  EndIf
  ProcedureReturn CallWindowProc_(OriginProc,hwnd,msg,wParam,lParam)
EndProcedure   

ProcedureDLL Listbox(number,x,y,width,height,itemHeight,parent)
  window=OpenWindow(#PB_Any,x,y,width,height,"",#PB_Window_BorderLess|#PB_Window_Invisible)
  SetWindowLong_(WindowID(window),#GWL_STYLE, #WS_CHILD|#WS_DLGFRAME|#WS_EX_CLIENTEDGE|#WS_CLIPCHILDREN|#WS_CLIPSIBLINGS )
  SetParent_(WindowID(window),parent)
  ShowWindow_(WindowID(window),#SW_SHOW)
  
  lb=ListViewGadget(#PB_Any,0,0,width,height,#LBS_OWNERDRAWFIXED|#LBS_HASSTRINGS)
  OriginProc= SetWindowLong_(WindowID(window), #GWL_WNDPROC, @ListboxProc())
  OriginProc1= SetWindowLong_(GadgetID(lb), #GWL_WNDPROC, @ListboxProc())
  ProcedureReturn lb
EndProcedure
ProcedureDLL AddListboxItem(listbox,Position,text.s,imageid)
  If Position =-1
    itemreturn=SendMessage_(GadgetID(listbox),#LB_ADDSTRING,0,text)
    ProcedureReturn itemreturn
  Else
    itemreturn=SendMessage_(GadgetID(listbox),#LB_INSERTSTRING,Position,text)
    ProcedureReturn itemreturn
  EndIf
EndProcedure

#WindowWidth  = 390
#WindowHeight = 350
If OpenWindow(0, 100, 200, #WindowWidth, #WindowHeight, "", #PB_Window_MinimizeGadget)
  
  listbox=Listbox(0,50,50,100,200,0,WindowID(0))
  
  For a=0 To 10
    AddListboxItem(listbox,a,"test",0)
  Next
  Repeat
    
    EventID = WaitWindowEvent()
    
    If EventID = #PB_Event_Gadget
      
      Select EventGadget()
        Case listbox
          Debug GetGadgetState(listbox)
      EndSelect
      
    EndIf
    
  Until EventID = #PB_Event_CloseWindow
  
EndIf

End

[Fred]

Great code !