ListIcon columns with CheckBoxes [Windows]

[RASHAD]

Straight forward
Easy to handle
Column 0 completely hidden to avoid its speciality
Well it is a try to correct my old posts mess

Code: Select all

 #HDF_IMAGE = $800
 #HDI_IMAGE = $20

Global oldproc, header_h ,Header,cell.LVHITTESTINFO,ii.lv_item,hi.HDITEM, hh.HD_HITTESTINFO

ii\mask     = #LVIF_IMAGE
hi\mask     = #HDI_IMAGE
hi\fmt      = #HDF_IMAGE

Procedure setItemImg(Row,Col,Img)  
  ii\iItem    = Row
  ii\iSubItem = Col
  ii\iImage   = Img
  SendMessage_(GadgetID(0), #LVM_SETITEM, 0, @ii)
EndProcedure

Procedure getItemImg(Row,Col)
  ii\iItem    = Row
  ii\iSubItem = Col
  SendMessage_(GadgetID(0), #LVM_GETITEM, 0, @ii)
EndProcedure

Procedure setHeaderImg(Col,Img)  
  hi\iImage = Img
  SendMessage_(Header , #HDM_SETITEM, Col, @hi)
EndProcedure

Procedure getHeaderImg(Col)
  SendMessage_(Header , #HDM_GETITEM, col, @hi)
EndProcedure

Procedure IsMouseOver(hWnd) 
    GetWindowRect_(hWnd,r.RECT) 
    GetCursorPos_(p.POINT) 
    Result = PtInRect_(r,p\y << 32 + p\x) 
    ProcedureReturn Result 
EndProcedure 

Procedure Hheight(hWnd, uMsg, wParam, lParam)
   Select uMsg
      Case #HDM_LAYOUT
        result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
        *hdlayout.HD_LAYOUT = lParam
        If *hdlayout\prc <> 0
            *rect.RECT = *hdlayout\prc
            *rect\top = header_h
        EndIf
        If *hdlayout\pwpos <> 0
            *windowpos.WINDOWPOS = *hdlayout\pwpos
            *windowpos\cy = header_h
        EndIf
     
      Default
        result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
           
    EndSelect
    ProcedureReturn result
EndProcedure

Procedure WinCallback(hWnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents 
  Select uMsg

    Case #WM_SIZE
        ResizeGadget(0,#PB_Ignore,#PB_Ignore, WindowWidth(0)-20, WindowHeight(0)-60)
        ResizeGadget(2,#PB_Ignore,WindowHeight(0)-30,80,20)
        
    Case #WM_NOTIFY
      *NMHDR.NMHDR = lParam
         If *NMHDR\hWndFrom = Header; And *NMHDR\code = #HDN_FIRST
            *phdn.NMHEADER = lParam
            row = *phdn\iItem                 
            If  row = 0
                  ProcedureReturn 1
            EndIf
         EndIf
        
  EndSelect
  ProcedureReturn result
EndProcedure

LoadFont(0,"Marlett",120)
iinf.ICONINFO
iinf\fIcon = 1

ILwnd = ImageList_Create_(26,20,#ILC_COLOR32| #ILC_MASK, 0, 100)

CreateImage(0,26,20,24,#White)
iinf\hbmMask = ImageID(0)
iinf\hbmColor = ImageID(0)
Icwnd = CreateIconIndirect_(iinf)
ImageList_AddIcon_(ILwnd,Icwnd)

For img = 0 To 1
  CreateImage(0,260,200,24,#White)
  StartDrawing(ImageOutput(0))
  Box(60,0,160,160,0)
  Box(80,20,120,120,$FFFFFF)
  If img = 1
    DrawingFont(FontID(0))
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText(70,0,Chr($61),0)
  EndIf
  StopDrawing()
  ResizeImage(0,26,20,#PB_Image_Smooth)
  iinf\hbmMask = ImageID(0)
  iinf\hbmColor = ImageID(0)
  Icwnd = CreateIconIndirect_(iinf)
  ImageList_AddIcon_(ILwnd,Icwnd)
Next

FreeFont(0)
FreeImage(0)

LoadFont(0,"Broadway",16)

OpenWindow(0,0,0,800,500, "Special ListIcon", #PB_Window_ScreenCentered |#PB_Window_SystemMenu | #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)       
ListIconGadget(0,10,10,780,440,"",0,#PB_ListIcon_GridLines)
SetGadgetColor(0,#PB_Gadget_BackColor,$EEEEEF)
SetGadgetColor(0,#PB_Gadget_LineColor,$CBCBCC)

SetGadgetFont(0,FontID(0))

AddGadgetColumn(0, 1, "Column 1",150)
AddGadgetColumn(0, 2, "Column 2",150)
AddGadgetColumn(0, 3, "Column 3",150)
AddGadgetColumn(0, 4, "Column 4",150)
AddGadgetColumn(0, 5, "Column 5",150)

SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)

SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, ILwnd)

For i = 0 To 5
  AddGadgetItem(0, -1, Chr(10)+"  111"+Chr(10)+"  222"+Chr(10)+ "  333"+Chr(10)+ "  444")
Next

itemn = CountGadgetItems(0)

Dim order(itemn)
For sub = 0 To itemn  
  order(sub)=sub+1
Next
SendMessage_(GadgetID(0), #LVM_SETCOLUMNORDERARRAY, itemn, @order()) 

ButtonGadget(2,10,470,80,20,"Get item state")

header_h = 42
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
SendMessage_(header,#HDM_SETBITMAPMARGIN,0,0)

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())

For cel = 0 To 5
  setItemImg(cel,1,1)
  setItemImg(cel,2,1)
  setItemImg(cel,4,1)
Next

setHeaderImg(1,1) 
setHeaderImg(2,1)
setHeaderImg(4,1) 

SetWindowCallback(@WinCallback())

Repeat
  Select WaitWindowEvent()
     
      Case #PB_Event_CloseWindow
        Quit = 1
            
      Case #WM_LBUTTONDOWN
        If IsMouseOver(header) 
          GetCursorPos_(@p.POINT)
          ScreenToClient_(header, p)
          hh\pt\x = p\x
          hh\pt\y = p\y
          SendMessage_(header,#HDM_HITTEST,0,@hh)
          SendMessage_(header,#HDM_GETITEMRECT,hh\iItem,r.RECT)
          If p\x < (r\left+20) And p\x > r\Left And p\y > 10 And p\y < 26
            getHeaderImg(hh\iItem)
            hindex = hi\iImage
            If hindex % 2 = 1
              hindex + 1
            Else
              hindex - 1
            EndIf            
            setHeaderImg(hh\iItem,hindex)
            For item = 0 To itemn
              setItemImg(item,hh\iItem,hindex)
            Next 
          EndIf
        EndIf
     
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            Select EventType()
              Case #PB_EventType_LeftClick
                GetCursorPos_(@p.POINT)
                ScreenToClient_(GadgetID(0), p)
                cell\pt\x = p\x
                cell\pt\y = p\y  
                SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST,0,@cell)
                LI_row = cell\iItem
                LI_col = cell\iSubItem
                r.RECT
                r\top = LI_col
                r\left = #LVIR_BOUNDS  
                SendMessage_(GadgetID(0),#LVM_GETSUBITEMRECT,LI_col,@r)
                If p\x > r\left And p\x < (r\left+26)
                  getItemImg(LI_row,LI_col)
                  index = ii\iImage
                  If index % 2 = 1
                     setItemImg(LI_row,LI_col,index + 1)
                  Else
                     setItemImg(LI_row,LI_col,index - 1)
                  EndIf 
                Else
                  SetGadgetItemColor(0,OLdr,#PB_Gadget_FrontColor,#Black ,Oldc)
                  SetGadgetItemColor(0,Oldr, #PB_Gadget_BackColor, $E6E6E6,Oldc)
                  SetGadgetItemColor(0,LI_row,#PB_Gadget_FrontColor, GetSysColor_(#COLOR_HIGHLIGHTTEXT) ,LI_col)
                  SetGadgetItemColor(0,LI_row, #PB_Gadget_BackColor,GetSysColor_(#COLOR_HIGHLIGHT),LI_col)
                  OLdr = LI_row
                  OLdc = LI_col
                EndIf
            EndSelect 
            
          Case 2
            getItemImg(2,1)
            If ii\iImage = 2
              Debug "Checkbox is checked" 
            Else
              Debug "Checkbox NOT checked" 
            EndIf       
        EndSelect             
  EndSelect

Until Quit = 1
End

Column 0 exist:

Code: Select all

 #HDF_IMAGE = $800
 #HDI_IMAGE = $20

Global oldproc, header_h ,Header,cell.LVHITTESTINFO,ii.lv_item,hi.HDITEM, hh.HD_HITTESTINFO

ii\mask     = #LVIF_IMAGE
hi\mask     = #HDI_IMAGE
hi\fmt      = #HDF_IMAGE

Procedure setItemImg(Row,Col,Img)  
  ii\iItem    = Row
  ii\iSubItem = Col
  ii\iImage   = Img
  SendMessage_(GadgetID(0), #LVM_SETITEM, 0, @ii)
EndProcedure

Procedure getItemImg(Row,Col)
  ii\iItem    = Row
  ii\iSubItem = Col
  SendMessage_(GadgetID(0), #LVM_GETITEM, 0, @ii)
EndProcedure

Procedure setHeaderImg(Col,Img)  
  hi\iImage = Img
  SendMessage_(Header , #HDM_SETITEM, Col, @hi)
EndProcedure

Procedure getHeaderImg(Col)
  SendMessage_(Header , #HDM_GETITEM, col, @hi)
EndProcedure

Procedure IsMouseOver(hWnd) 
    GetWindowRect_(hWnd,r.RECT) 
    GetCursorPos_(p.POINT) 
    Result = PtInRect_(r,p\y << 32 + p\x) 
    ProcedureReturn Result 
EndProcedure 

Procedure Hheight(hWnd, uMsg, wParam, lParam)
   Select uMsg
      Case #HDM_LAYOUT
        result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
        *hdlayout.HD_LAYOUT = lParam
        If *hdlayout\prc <> 0
            *rect.RECT = *hdlayout\prc
            *rect\top = header_h
        EndIf
        If *hdlayout\pwpos <> 0
            *windowpos.WINDOWPOS = *hdlayout\pwpos
            *windowpos\cy = header_h
        EndIf
     
      Default
        result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
           
    EndSelect
    ProcedureReturn result
EndProcedure

Procedure WinCallback(hWnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents 
  Select uMsg

   Case #WM_SIZE
        ResizeGadget(0,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20, WindowHeight(0)-60)
        ResizeGadget(2,#PB_Ignore,WindowHeight(0)-30,80,20)
        
  EndSelect
  ProcedureReturn result
EndProcedure

LoadFont(0,"Marlett",120)
iinf.ICONINFO
iinf\fIcon = 1

ILwnd = ImageList_Create_(26,20,#ILC_COLOR32| #ILC_MASK, 0, 100)

CreateImage(0,26,20,24,#White)
iinf\hbmMask = ImageID(0)
iinf\hbmColor = ImageID(0)
Icwnd = CreateIconIndirect_(iinf)
ImageList_AddIcon_(ILwnd,Icwnd)

For img = 0 To 1
  CreateImage(0,260,200,24,#White)
  StartDrawing(ImageOutput(0))
  Box(60,0,160,160,0)
  Box(80,20,120,120,$FFFFFF)
  If img = 1
    DrawingFont(FontID(0))
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText(70,0,Chr($61),0)
  EndIf
  StopDrawing()
  ResizeImage(0,26,20,#PB_Image_Smooth)
  iinf\hbmMask = ImageID(0)
  iinf\hbmColor = ImageID(0)
  Icwnd = CreateIconIndirect_(iinf)
  ImageList_AddIcon_(ILwnd,Icwnd)
Next

FreeFont(0)
FreeImage(0)

LoadFont(0,"Broadway",16)

OpenWindow(0,0,0,800,500, "Special ListIcon", #PB_Window_ScreenCentered |#PB_Window_SystemMenu | #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)       
ListIconGadget(0,10,10,780,440,"Column 0",150,#PB_ListIcon_GridLines)
SetGadgetColor(0,#PB_Gadget_BackColor,$EEEEEF)
SetGadgetColor(0,#PB_Gadget_LineColor,$CBCBCC)

SetGadgetFont(0,FontID(0))

AddGadgetColumn(0, 1, "Column 1",150)
AddGadgetColumn(0, 2, "Column 2",150)
AddGadgetColumn(0, 3, "Column 3",150)
AddGadgetColumn(0, 4, "Column 4",150)
AddGadgetColumn(0, 5, "Column 5",150)

SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)

SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, ILwnd)

For i = 0 To 5
  AddGadgetItem(0, -1, "  000"+Chr(10)+"  111"+Chr(10)+"  222"+Chr(10)+ "  333"+Chr(10)+ "  444")
Next

itemn = CountGadgetItems(0)

ButtonGadget(2,10,470,80,20,"Get item state")

header_h = 42
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
SendMessage_(header,#HDM_SETBITMAPMARGIN,0,0)

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())

For cel = 0 To 5
  setItemImg(cel,0,1)
  setItemImg(cel,1,1)
  setItemImg(cel,2,1)
  setItemImg(cel,4,1)
Next

setHeaderImg(0,1)
setHeaderImg(1,1) 
setHeaderImg(2,1)
setHeaderImg(4,1) 

SetWindowCallback(@WinCallback())

Repeat
  Select WaitWindowEvent()
     
      Case #PB_Event_CloseWindow
        Quit = 1
            
      Case #WM_LBUTTONDOWN
        If IsMouseOver(header) 
          GetCursorPos_(@p.POINT)
          ScreenToClient_(header, p)
          hh\pt\x = p\x
          hh\pt\y = p\y
          SendMessage_(header,#HDM_HITTEST,0,@hh)
          SendMessage_(header,#HDM_GETITEMRECT,hh\iItem,r.RECT)
          If p\x < (r\left+20) And p\x > r\Left And p\y > 10 And p\y < 26
            getHeaderImg(hh\iItem)
            hindex = hi\iImage
            If hindex % 2 = 1
              hindex + 1
            Else
              hindex - 1
            EndIf            
            setHeaderImg(hh\iItem,hindex)
            For item = 0 To itemn
              setItemImg(item,hh\iItem,hindex)
            Next 
          EndIf
        EndIf
     
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            Select EventType()
              Case #PB_EventType_LeftClick
                GetCursorPos_(@p.POINT)
                ScreenToClient_(GadgetID(0), p)
                cell\pt\x = p\x
                cell\pt\y = p\y  
                SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST,0,@cell)
                LI_row = cell\iItem
                LI_col = cell\iSubItem
                r.RECT
                r\top = LI_col
                r\left = #LVIR_BOUNDS  
                SendMessage_(GadgetID(0),#LVM_GETSUBITEMRECT,LI_col,@r)
                If p\x > r\left And p\x < (r\left+26)
                  getItemImg(LI_row,LI_col)
                  index = ii\iImage
                  If index % 2 = 1
                     setItemImg(LI_row,LI_col,index + 1)
                  Else
                     setItemImg(LI_row,LI_col,index - 1)
                  EndIf 
                Else
                  SetGadgetItemColor(0,OLdr,#PB_Gadget_FrontColor,#Black ,Oldc)
                  SetGadgetItemColor(0,Oldr, #PB_Gadget_BackColor, $E6E6E6,Oldc)
                  SetGadgetItemColor(0,LI_row,#PB_Gadget_FrontColor,GetSysColor_(#COLOR_HIGHLIGHTTEXT) ,LI_col)
                  SetGadgetItemColor(0,LI_row, #PB_Gadget_BackColor,GetSysColor_(#COLOR_HIGHLIGHT),LI_col)
                  OLdr = LI_row
                  OLdc = LI_col
                EndIf
            EndSelect 
            
          Case 2
            getItemImg(2,1)
            If ii\iImage = 2
              Debug "Checkbox is checked" 
            Else
              Debug "Checkbox NOT checked" 
            EndIf       
        EndSelect             
  EndSelect

Until Quit = 1
End

[Kwai chang caine]

Works very well
Thanks for sharing

[Fredi]

Thanks RASHAD

[RASHAD]

Hi KCC
Hi Fredi

- Bugs fixed
- Used MS standards
- Final version you can say

Code: Select all

 #HDF_IMAGE = $800
 #HDI_IMAGE = $20

Global oldproc, header_h , Header, cell.LVHITTESTINFO, ii.lv_item, hi.HDITEM, hh.HD_HITTESTINFO
Global Dim hitem(0)

ii\mask     = #LVIF_IMAGE
hi\mask     = #HDI_IMAGE
hi\fmt      = #HDF_IMAGE

Procedure setItemImg(Row,Col,Img) 
  ii\iItem    = Row
  ii\iSubItem = Col
  ii\iImage   = Img
  SendMessage_(GadgetID(0), #LVM_SETITEM, 0, @ii)
EndProcedure

Procedure getItemImg(Row,Col)
  ii\iItem    = Row
  ii\iSubItem = Col
  SendMessage_(GadgetID(0), #LVM_GETITEM, 0, @ii)
EndProcedure

Procedure setHeaderImg(Col,Img)
  hitem(Col) = 1 
  hi\iImage = Img
  SendMessage_(Header , #HDM_SETITEM, Col, @hi)
EndProcedure

Procedure getHeaderImg(Col)  
  SendMessage_(Header , #HDM_GETITEM, Col, @hi)
EndProcedure

Procedure IsMouseOver(hWnd)
  GetWindowRect_(hWnd,r.RECT)
  GetCursorPos_(p.POINT)
  Result = PtInRect_(r,p\y << 32 + p\x)
  ProcedureReturn Result
EndProcedure

Procedure Hheight(hWnd, uMsg, wParam, lParam)
  result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #HDM_LAYOUT
      *hdlayout.HD_LAYOUT = lParam
      If *hdlayout\prc <> 0
          *rect.RECT = *hdlayout\prc
          *rect\top = header_h
      EndIf
      If *hdlayout\pwpos <> 0
          *windowpos.WINDOWPOS = *hdlayout\pwpos
          *windowpos\cy = header_h
      EndIf
           
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure WinCallback(hWnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
  Select uMsg

    Case #WM_SIZE
        ResizeGadget(0,#PB_Ignore,#PB_Ignore, WindowWidth(0)-20, WindowHeight(0)-60)
        ResizeGadget(2,#PB_Ignore,WindowHeight(0)-30,80,20)
              
  EndSelect
  ProcedureReturn result
EndProcedure

LoadFont(0,"Broadway",16)
LoadFont(1,"Consolas",12,#PB_Font_Bold )

OpenWindow(0,0,0,800,500, "Special ListIcon", #PB_Window_ScreenCentered |#PB_Window_SystemMenu | #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)       
ListIconGadget(0,10,10,780,440,"",0, #PB_ListIcon_GridLines| #PB_ListIcon_CheckBoxes)
SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)

SetGadgetColor(0,#PB_Gadget_BackColor,$EEEEEF)
SetGadgetColor(0,#PB_Gadget_LineColor,$CBCBCC)
SetGadgetFont(0,FontID(1))

AddGadgetColumn(0, 1, "Column 1",150)
AddGadgetColumn(0, 2, "Column 2",150)
AddGadgetColumn(0, 3, "Column 3",150)
AddGadgetColumn(0, 4, "Column 4",150)
AddGadgetColumn(0, 5, "Column 5",150)

For i = 0 To 20
  AddGadgetItem(0, -1, Chr(10)+"111"+Chr(10)+"222"+Chr(10)+ "333"+Chr(10)+ "444")
Next

li = SendMessage_(GadgetID(0),#LVM_GETIMAGELIST,#LVSIL_STATE,0)

CreateImage(0,22,32,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(0))
  ImageList_Draw_(li,0,hdc,6,10,#ILD_NORMAL)
StopDrawing()

CreateImage(1,22,32,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(1))
  ImageList_Draw_(li,1,hdc,6,10,#ILD_NORMAL)
StopDrawing()

nli = ImageList_Create_(22,32,#ILC_COLOR32| #ILC_MASK, 0, 2)
ImageList_Add_(nli,ImageID(0),0)
ImageList_Add_(nli,ImageID(1),0)

FreeImage(0)
FreeImage(1)

SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, nli)

header_h = 42
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
SendMessage_(header,#HDM_SETBITMAPMARGIN,0,0)
SendMessage_(header,#WM_SETFONT,FontID(0),0)

subn  = SendMessage_(header, #HDM_GETITEMCOUNT, 0,0)
itemn = SendMessage_(GadgetID(0), #LVM_GETITEMCOUNT, 0,0)

Dim order(subn)
For sub = 0 To subn 
  order(sub)=sub+1
Next
SendMessage_(GadgetID(0), #LVM_SETCOLUMNORDERARRAY, subn, @order())

ButtonGadget(2,10,470,80,20,"Get item state")

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())

For cel = 0 To itemn
  setItemImg(cel,1,0)
  setItemImg(cel,2,0)
  setItemImg(cel,4,0)
Next

ReDim hitem(subn)

setHeaderImg(1,0)
setHeaderImg(2,0)
setHeaderImg(4,0)

SetWindowCallback(@WinCallback())

Repeat
  Select WaitWindowEvent()     
    Case #PB_Event_CloseWindow
      Quit = 1
         
    Case #WM_LBUTTONDOWN
      If IsMouseOver(header)
        GetCursorPos_(@p.POINT)
        ScreenToClient_(header, p)
        hh\pt\x = p\x
        hh\pt\y = p\y
        SendMessage_(header,#HDM_HITTEST,0,@hh)
        SendMessage_(header,#HDM_GETITEMRECT,hh\iItem,r.RECT)
        getHeaderImg(hh\iItem)
        hindex = hi\iImage
        If p\x > (r\left+6) And p\x < (r\Left+18) And p\y > header_h/2-4 And p\y < header_h/2+4 And hitem(hh\iItem) = 1
          setHeaderImg(hh\iItem,hindex ! 1)
          For item = 0 To itemn
            setItemImg(item,hh\iItem,hindex ! 1)
          Next
        EndIf
      EndIf
   
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          Select EventType()
            Case #PB_EventType_LeftClick
              GetCursorPos_(@p.POINT)
              ScreenToClient_(GadgetID(0), p)
              cell\pt\x = p\x
              cell\pt\y = p\y 
              SendMessage_(GadgetID(0), #LVM_SUBITEMHITTEST,0, @cell)
              LI_row = cell\iItem
              LI_col = cell\iSubItem
              r.RECT
              r\top = LI_col
              r\left = #LVIR_BOUNDS 
              SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT,LI_col, @r)
              getItemImg(LI_row,LI_col)
              index = ii\iImage
              If p\x > (r\left+6) And p\x < (r\left+18) And index >= 0
                setItemImg(LI_row,LI_col,index ! 1)
              Else
                SetGadgetItemColor(0,OLdr,#PB_Gadget_FrontColor, $0 , Oldc)
                SetGadgetItemColor(0,Oldr, #PB_Gadget_BackColor, $EEEEEF, Oldc)
                SetGadgetItemColor(0,LI_row, #PB_Gadget_FrontColor, GetSysColor_(#COLOR_HIGHLIGHTTEXT) , LI_col)
                SetGadgetItemColor(0,LI_row, #PB_Gadget_BackColor, GetSysColor_(#COLOR_HIGHLIGHT), LI_col)
                OLdr = LI_row
                OLdc = LI_col
              EndIf
          EndSelect
         
        Case 2
          getItemImg(2,1)
          If ii\iImage = 1
            Debug "Checkbox is checked"
          Else
            Debug "Checkbox NOT checked"
          EndIf       
      EndSelect             
  EndSelect

Until Quit = 1
End

[Kwai chang caine]

Hello RASHAD
Strange this one not work perfectly here
I have black square around each checkbox and furthermore even when i check one or several checkbox i have "Checkbox NOT checked"

[RASHAD]

Hi KCC
Modern theme must be enabled

[Kwai chang caine]

It's right the big magician RASHAD know all, of my life



I have not activate the aero in my widows, i have the same desktop than W95
May be it's the reason why ??
Because i have activate the XP theme in compiler..and it's again worst, this time i have square aroud header too

[RASHAD]

Specially for KCC

Code: Select all

 
 #HDF_IMAGE = $800
 #HDI_IMAGE = $20

Global oldproc, header_h , Header, cell.LVHITTESTINFO, ii.lv_item, hi.HDITEM, hh.HD_HITTESTINFO
Global Dim hitem(0)

ii\mask     = #LVIF_IMAGE
hi\mask     = #HDI_IMAGE
hi\fmt      = #HDF_IMAGE

Procedure setItemImg(Row,Col,Img)
  ii\iItem    = Row
  ii\iSubItem = Col
  ii\iImage   = Img
  SendMessage_(GadgetID(0), #LVM_SETITEM, 0, @ii)
EndProcedure

Procedure getItemImg(Row,Col)
  ii\iItem    = Row
  ii\iSubItem = Col
  SendMessage_(GadgetID(0), #LVM_GETITEM, 0, @ii)
EndProcedure

Procedure setHeaderImg(Col,Img)
  hitem(Col) = 1
  hi\iImage = Img
  SendMessage_(Header , #HDM_SETITEM, Col, @hi)
EndProcedure

Procedure getHeaderImg(Col) 
  SendMessage_(Header , #HDM_GETITEM, Col, @hi)
EndProcedure

Procedure IsMouseOver(hWnd)
  GetWindowRect_(hWnd,r.RECT)
  GetCursorPos_(p.POINT)
  Result = PtInRect_(r,p\y << 32 + p\x)
  ProcedureReturn Result
EndProcedure

Procedure Hheight(hWnd, uMsg, wParam, lParam)
  result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #HDM_LAYOUT
      *hdlayout.HD_LAYOUT = lParam
      If *hdlayout\prc <> 0
          *rect.RECT = *hdlayout\prc
          *rect\top = header_h
      EndIf
      If *hdlayout\pwpos <> 0
          *windowpos.WINDOWPOS = *hdlayout\pwpos
          *windowpos\cy = header_h
      EndIf
           
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure WinCallback(hWnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
  Select uMsg

    Case #WM_SIZE
        ResizeGadget(0,#PB_Ignore,#PB_Ignore, WindowWidth(0)-20, WindowHeight(0)-60)
        ResizeGadget(2,#PB_Ignore,WindowHeight(0)-30,80,20)
             
  EndSelect
  ProcedureReturn result
EndProcedure

LoadFont(0,"Broadway",16)
LoadFont(1,"Consolas",12,#PB_Font_Bold )

OpenWindow(0,0,0,800,500, "Special ListIcon", #PB_Window_ScreenCentered |#PB_Window_SystemMenu | #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)       
ListIconGadget(0,10,10,780,440,"",0, #PB_ListIcon_GridLines| #PB_ListIcon_CheckBoxes)
SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)

libcolor = $EEEEEF
SetGadgetColor(0,#PB_Gadget_BackColor,libcolor)
SetGadgetColor(0,#PB_Gadget_LineColor,$CBCBCC)
SetGadgetFont(0,FontID(1))

AddGadgetColumn(0, 1, "Column 1",150)
AddGadgetColumn(0, 2, "Column 2",150)
AddGadgetColumn(0, 3, "Column 3",150)
AddGadgetColumn(0, 4, "Column 4",150)
AddGadgetColumn(0, 5, "Column 5",150)

For i = 0 To 20
  AddGadgetItem(0, -1, Chr(10)+"111"+Chr(10)+"222"+Chr(10)+ "333"+Chr(10)+ "444")
Next

li = SendMessage_(GadgetID(0),#LVM_GETIMAGELIST,#LVSIL_STATE,0)

libcolor = $EEEEEF
CreateImage(0,22,32,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(0))
  Box(0,0,22,32,libcolor)
  ImageList_Draw_(li,0,hdc,6,10,#ILD_NORMAL	)
StopDrawing()

CreateImage(1,22,32,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(1))
  Box(0,0,22,32,libcolor)
  ImageList_Draw_(li,1,hdc,6,10,#ILD_NORMAL	)
StopDrawing()

nli = ImageList_Create_(22,32,#ILC_COLOR32| #ILC_MASK, 0, 2)
ImageList_Add_(nli,ImageID(0),0)
ImageList_Add_(nli,ImageID(1),0)

FreeImage(0)
FreeImage(1)

SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, nli)

header_h = 42
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
SendMessage_(header,#HDM_SETBITMAPMARGIN,0,0)
SendMessage_(header,#WM_SETFONT,FontID(0),0)

subn  = SendMessage_(header, #HDM_GETITEMCOUNT, 0,0)
itemn = SendMessage_(GadgetID(0), #LVM_GETITEMCOUNT, 0,0)

Dim order(subn)
For sub = 0 To subn
  order(sub)=sub+1
Next
SendMessage_(GadgetID(0), #LVM_SETCOLUMNORDERARRAY, subn, @order())

ButtonGadget(2,10,470,80,20,"Get item state")

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())

For cel = 0 To itemn
  setItemImg(cel,1,0)
  setItemImg(cel,2,0)
  setItemImg(cel,4,0)
Next

ReDim hitem(subn)

setHeaderImg(1,0)
setHeaderImg(2,0)
setHeaderImg(4,0)

SetWindowCallback(@WinCallback())

Repeat
  Select WaitWindowEvent()     
    Case #PB_Event_CloseWindow
      Quit = 1
         
    Case #WM_LBUTTONDOWN
      If IsMouseOver(header)
        GetCursorPos_(@p.POINT)
        ScreenToClient_(header, p)
        hh\pt\x = p\x
        hh\pt\y = p\y
        SendMessage_(header,#HDM_HITTEST,0,@hh)
        SendMessage_(header,#HDM_GETITEMRECT,hh\iItem,r.RECT)
        getHeaderImg(hh\iItem)
        hindex = hi\iImage
        If p\x > (r\left+6) And p\x < (r\Left+18) And p\y > header_h/2-4 And p\y < header_h/2+4 And hitem(hh\iItem) = 1
          setHeaderImg(hh\iItem,hindex ! 1)
          For item = 0 To itemn
            setItemImg(item,hh\iItem,hindex ! 1)
          Next
        EndIf
      EndIf
   
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          Select EventType()
            Case #PB_EventType_LeftClick
              GetCursorPos_(@p.POINT)
              ScreenToClient_(GadgetID(0), p)
              cell\pt\x = p\x
              cell\pt\y = p\y
              SendMessage_(GadgetID(0), #LVM_SUBITEMHITTEST,0, @cell)
              LI_row = cell\iItem
              LI_col = cell\iSubItem
              r.RECT
              r\top = LI_col
              r\left = #LVIR_BOUNDS
              SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT,LI_col, @r)
              getItemImg(LI_row,LI_col)
              index = ii\iImage
              If p\x > (r\left+6) And p\x < (r\left+18) And index >= 0
                setItemImg(LI_row,LI_col,index ! 1)
              Else
                SetGadgetItemColor(0,OLdr,#PB_Gadget_FrontColor, $0 , Oldc)
                SetGadgetItemColor(0,Oldr, #PB_Gadget_BackColor, $EEEEEF, Oldc)
                SetGadgetItemColor(0,LI_row, #PB_Gadget_FrontColor, GetSysColor_(#COLOR_HIGHLIGHTTEXT) , LI_col)
                SetGadgetItemColor(0,LI_row, #PB_Gadget_BackColor, GetSysColor_(#COLOR_HIGHLIGHT), LI_col)
                OLdr = LI_row
                OLdc = LI_col
              EndIf
          EndSelect
         
        Case 2
          getItemImg(2,1)
          If ii\iImage = 1
            Debug "Checkbox is checked"
          Else
            Debug "Checkbox NOT checked"
          EndIf       
      EndSelect             
  EndSelect

Until Quit = 1
End

[Kwai chang caine]

Yeeeessss !!!!
The bad black square is gone for always !!!

I don't remember if i have say to you you are an angel !!!! so i say it another time

A little problem again, my three checkboxs checked are not detecting

Checkbox NOT checked
Checkbox NOT checked
Checkbox NOT checked