listicon: can header be multi-lines?

Just starting out? Need help? Post your questions and find answers here.
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

listicon: can header be multi-lines?

Post by morosh »

Hello:
In a listicon, sometimes we have a big header, but contents not really, is-it possible to have a multi-lines header? (in a different font and height if possible)
using w7-x64

thanks
PureBasic: Surprisingly simple, diabolically powerful
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: listicon: can header be multi-lines?

Post by RASHAD »

Hi morosh
#1 :

Code: Select all

Global oldhproc, header_h,header,col,i.ICONINFO

Procedure SetHeaderImage(Gadget, Image, Column,index)
  HwndHeader = SendMessage_(GadgetID(Gadget), #LVM_GETHEADER, 0, 0) 
  VarHeader.HDITEM\mask = #HDI_BITMAP | #HDI_FORMAT 
  VarHeader\fmt = #HDF_BITMAP
  VarHeader\hbm = ImageID(index)
  SendMessage_(HwndHeader, #HDM_SETITEM, Column, @VarHeader) 
EndProcedure 

Procedure lihCB(hWnd, uMsg, wParam, lParam)    
   Select uMsg
      Case #HDM_LAYOUT
        result = CallWindowProc_(oldhproc, 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_(oldhproc, hWnd, uMsg, wParam, lParam)    
    EndSelect
    ProcedureReturn result
EndProcedure

Procedure sizeCB()
  ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-50)
EndProcedure

header_h = 40

LoadFont(0,"Georgia",16,#PB_Font_Bold) 
LoadFont(1,"Tahoma",8)
LoadFont(2,"Tahoma",12)

LoadImage(100, #PB_Compiler_Home + "examples/Sources/Data/PureBasicLogo.bmp")

OpenWindow(0, 0, 0, 600, 400, "ListIcon Header", #PB_Window_SystemMenu |#PB_Window_ScreenCentered|#PB_Window_SizeGadget)

ListIconGadget(0, 10, 10, 580, 350, "", 0,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect )
AddGadgetColumn(0,1,"",200)
AddGadgetColumn(0,2,"",200)
AddGadgetColumn(0,3,"",200)

For l = 1 To 100
    AddGadgetItem(0, -1, Str(l)+Chr(10) + "Item " + Str(l) + Chr(10)+"Item " + Str(l)+ Chr(10)+"Item " + Str(l)) 
Next

Dim order(3)
  order(0) = 1
  order(1) = 2
  order(2) = 3
SendMessage_(GadgetID(0), #LVM_SETCOLUMNORDERARRAY, 4, @order())

SetGadgetColor(0,#PB_Gadget_BackColor,$E2FEFE)
SetGadgetFont(0,FontID(2))

header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)

oldhproc = SetWindowLongPtr_(header, #GWL_WNDPROC, @lihCB())

SendMessage_(header,#HDM_SETBITMAPMARGIN,0,0)

CreateImage(0,600,60,24,$FFFFFF)
StartDrawing(ImageOutput(0))
  DrawImage(ImageID(100),0,0,250,60)
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(5,5,"RASHAD",$0000FF,$FFFFFF)
StopDrawing()

CreateImage(1,600,60,24,$FFFFFF)
StartDrawing(ImageOutput(1))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,10,"RASHAD",$000000,$FFFFFF)
  DrawingFont(FontID(1))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,35,"New Tech.",$0000FF,$E0FEFE)
StopDrawing()

CreateImage(2,600,60,24,$FFFFFF)
StartDrawing(ImageOutput(2))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,15,"RASHAD",$FF0000,$FFFFFF)
StopDrawing()

SetHeaderImage(0, 0, 1,0)
SetHeaderImage(0, 1, 2,1)
SetHeaderImage(0, 2, 3,2)

BindEvent(#PB_Event_SizeWindow,@sizeCB())

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
#2 :

Code: Select all

#HDF_IMAGE = $800
#HDI_IMAGE = $20

Global oldhproc, header_h,header,col,i.ICONINFO
i\fIcon = #True

Procedure SetHeaderImage(Gadget, Image, Column,index)
  HwndHeader = SendMessage_(GadgetID(Gadget), #LVM_GETHEADER, 0, 0) 
  VarHeader.HDITEM\mask = #HDI_IMAGE | #HDI_FORMAT; | #HDI_TEXT 
  VarHeader\fmt = #HDF_IMAGE
  VarHeader\iImage = index
  SendMessage_(HwndHeader, #HDM_SETITEM, Column, @VarHeader) 
EndProcedure 

Procedure lihCB(hWnd, uMsg, wParam, lParam)    
   Select uMsg
      Case #HDM_LAYOUT
        result = CallWindowProc_(oldhproc, 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_(oldhproc, hWnd, uMsg, wParam, lParam)    
    EndSelect
    ProcedureReturn result
EndProcedure

Procedure sizeCB()
  ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-50)
EndProcedure

header_h = 40

LoadFont(0,"Georgia",16,#PB_Font_Bold) 
LoadFont(1,"Tahoma",8)
LoadFont(2,"Tahoma",12)

LoadImage(100, #PB_Compiler_Home + "examples/Sources/Data/PureBasicLogo.bmp")

OpenWindow(0, 0, 0, 600, 400, "ListIcon Header", #PB_Window_SystemMenu |#PB_Window_ScreenCentered|#PB_Window_SizeGadget)

ListIconGadget(0, 10, 10, 580, 350, "", 0,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect )
AddGadgetColumn(0,1,"",200)
AddGadgetColumn(0,2,"",200)
AddGadgetColumn(0,3,"",200)


For l = 1 To 100
    AddGadgetItem(0, -1, Str(l)+Chr(10) + "Item " + Str(l) + Chr(10)+"Item " + Str(l)+ Chr(10)+"Item " + Str(l)) 
Next

Dim order(3)
  order(0) = 1
  order(1) = 2
  order(2) = 3
SendMessage_(GadgetID(0), #LVM_SETCOLUMNORDERARRAY, 4, @order())

SetGadgetColor(0,#PB_Gadget_BackColor,$E2FEFE)
SetGadgetFont(0,FontID(2))

header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)

oldhproc = SetWindowLongPtr_(header, #GWL_WNDPROC, @lihCB())

SendMessage_(header,#HDM_SETBITMAPMARGIN,0,0)

CreateImage(0,300,60,24,$FFFFFF)
StartDrawing(ImageOutput(0))
  DrawImage(ImageID(100),0,0,250,60)
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(5,5,"RASHAD",$0000FF,$FFFFFF)
StopDrawing()

CreateImage(1,300,60,24,$FFFFFF)
StartDrawing(ImageOutput(1))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,10,"RASHAD",$000000,$FFFFFF)
  DrawingFont(FontID(1))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,35,"New Tech.",$0000FF,$E0FEFE)
StopDrawing()

CreateImage(2,300,60,24,$FFFFFF)
StartDrawing(ImageOutput(2))
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,15,"RASHAD",$FF0000,$FFFFFF)
StopDrawing()

hilist = ImageList_Create_(300,header_h, #ILC_MASK | #ILC_COLOR32, 0, 5)
SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, hilist )
 
i\hbmMask = ImageID(0)
i\hbmColor = ImageID(0)
curHnd = CreateIconIndirect_(i)
ImageList_AddIcon_(hilist , curHnd)
i\hbmMask = ImageID(1)
i\hbmColor = ImageID(1)
curHnd_1 = CreateIconIndirect_(i)
ImageList_AddIcon_(hilist , curHnd_1)
 i\hbmMask = ImageID(2)
i\hbmColor = ImageID(2)
curHnd_2 = CreateIconIndirect_(i)
ImageList_AddIcon_(hilist , curHnd_2) 

SetHeaderImage(0, 0, 1,0)
SetHeaderImage(0, 1, 2,1)
SetHeaderImage(0, 2, 3,2)

BindEvent(#PB_Event_SizeWindow,@sizeCB())

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
Egypt my love
User avatar
CELTIC88
Enthusiast
Enthusiast
Posts: 154
Joined: Thu Sep 17, 2015 3:39 pm

Re: listicon: can header be multi-lines?

Post by CELTIC88 »

:D

#3

Code: Select all

Macro ListView_GETHEADER(hwnd)
  SendMessage_(hwnd ,#LVM_GETHEADER,0,0)
EndMacro

Global Header_Ex_Listview
Procedure Window_Callback(hWnd, uMsg, wParam, lParam) 
  Protected *tNMHDR.NMHDR=lParam
  Select uMsg
    Case #WM_NOTIFY
      Select *tNMHDR\code
        Case #NM_CUSTOMDRAW
          Protected *tNMCustomDraw.NMLVCUSTOMDRAW = lParam
          Select *tNMCustomDraw\nmcd\dwDrawStage
            Case #CDDS_PREPAINT                
              If *tNMHDR\hwndFrom = Header_Ex_Listview:ProcedureReturn #CDRF_NOTIFYITEMDRAW:EndIf
            Case #CDDS_ITEMPREPAINT
              ProcedureReturn #CDRF_NOTIFYPOSTPAINT
            Case #CDDS_ITEMPOSTPAINT
              DrawText_(*tNMCustomDraw\nmcd\hdc, "line 1", -1, *tNMCustomDraw\nmcd\rc, 0 )
              *tNMCustomDraw\nmcd\rc\top + 12
              DrawText_(*tNMCustomDraw\nmcd\hdc, "line 2", -1, *tNMCustomDraw\nmcd\rc, 0 )
              ProcedureReturn #CDRF_NEWFONT
          EndSelect
          
      EndSelect
  EndSelect
  
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure


OpenWindow(0, 0, 0, 600, 400, "ListIcon Header", 
           #PB_Window_SystemMenu |#PB_Window_ScreenCentered|#PB_Window_SizeGadget)
SetWindowCallback(@Window_Callback(),0)
ListIconGadget(0, 10, 10, 580, 350, "", 100,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect )
AddGadgetColumn(0, 1, "", 100)
AddGadgetColumn(0, 2, "", 100)
AddGadgetColumn(0, 3, "", 100)

Header_Ex_Listview = ListView_GETHEADER(GadgetID(0))

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow






interested in Cybersecurity..
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: listicon: can header be multi-lines?

Post by morosh »

Thanks RASHAD:
I guessed (from a previous post from you) that header as image could be a solution, but I was wondering if there is a solution via API.

thank you very much

@ CELTIC88:
nice solution, thank you
PureBasic: Surprisingly simple, diabolically powerful
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: listicon: can header be multi-lines?

Post by RASHAD »

Hi morosh
Modifying the code by CELTIC88 :)
Too much headache :mrgreen:
And the effect of clicking the header item not OK
I still prefer my tech. so simple and so flexible :P
First snippet :

Code: Select all


Global oldhproc, header,header_h 
Global Dim subtext.s(5,1)
subtext.s(0,0) = " Line 1"
subtext.s(0,1) = " Line 2"
subtext.s(1,0) = " Line 3"
subtext.s(1,1) = " Line 4"
subtext.s(2,0) = " Line 5"
subtext.s(2,1) = " Line 6"
subtext.s(3,0) = " Line 7"
subtext.s(3,1) = " Line 8"

Procedure headerCB(hWnd, uMsg, wParam, lParam)   
  Select uMsg
    Case #HDM_LAYOUT
      result = CallWindowProc_(oldhproc, 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_(oldhproc, hWnd, uMsg, wParam, lParam)   
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure Window_Callback(hWnd, uMsg, wParam, lParam)
  Protected *tNMHDR.NMHDR=lParam
  Select uMsg
    Case #WM_NOTIFY
      Select *tNMHDR\code
        Case #NM_CUSTOMDRAW
          Protected *tNMCustomDraw.NMLVCUSTOMDRAW = lParam
          Select *tNMCustomDraw\nmcd\dwDrawStage
            Case #CDDS_PREPAINT               
             If *tNMHDR\hwndFrom = Header:ProcedureReturn #CDRF_NOTIFYITEMDRAW:EndIf
            Case #CDDS_ITEMPREPAINT
              ProcedureReturn #CDRF_NOTIFYPOSTPAINT
            Case #CDDS_ITEMPOSTPAINT
              SetBkMode_(*tNMCustomDraw\nmcd\hdc,#TRANSPARENT)
              SetTextColor_(*tNMCustomDraw\nmcd\hdc,$0008FD)
              SelectObject_(*tNMCustomDraw\nmcd\hdc,FontID(0))              	
              DrawText_(*tNMCustomDraw\nmcd\hdc, subtext.s(*tNMCustomDraw\nmcd\dwItemSpec,0 ), -1, *tNMCustomDraw\nmcd\rc, 0 )
              SetTextColor_(*tNMCustomDraw\nmcd\hdc,$FD2400)
              SelectObject_(*tNMCustomDraw\nmcd\hdc,FontID(1))
              *tNMCustomDraw\nmcd\rc\top + 24
              DrawText_(*tNMCustomDraw\nmcd\hdc, subtext.s(*tNMCustomDraw\nmcd\dwItemSpec ,1), -1, *tNMCustomDraw\nmcd\rc, 0 )
              ProcedureReturn #CDRF_NEWFONT
          EndSelect
         
      EndSelect
  EndSelect
 
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

LoadFont(0,"Tahoma",16, #PB_Font_Italic |#PB_Font_Underline)
LoadFont(1,"Georgia",12)

header_h = 40
OpenWindow(0, 0, 0, 600, 400, "ListIcon Header",
           #PB_Window_SystemMenu |#PB_Window_ScreenCentered|#PB_Window_SizeGadget)
SetWindowCallback(@Window_Callback(),0)
ListIconGadget(0, 10, 10, 580, 350, "", 100,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect )
AddGadgetColumn(0, 1, "", 100)
AddGadgetColumn(0, 2, "", 100)
AddGadgetColumn(0, 3, "", 100)

header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
oldhproc = SetWindowLongPtr_(header, #GWL_WNDPROC, @headerCB())

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow


Second one:

Code: Select all

#HDF_IMAGE = $800
#HDI_IMAGE = $20
#HDSIL_NORMAL = 0
#HDSIL_STATE = 1

Global oldhproc, header_h,header,col,i.ICONINFO
i\fIcon = #True

Procedure SetHeaderImage(Column,index)
  VarHeader.HDITEM\mask = #HDI_IMAGE | #HDI_FORMAT; | #HDI_TEXT
  VarHeader\fmt = #HDF_IMAGE
  VarHeader\iImage = index
  SendMessage_(header, #HDM_SETITEM, Column, @VarHeader)
EndProcedure

Procedure headerCB(hWnd, uMsg, wParam, lParam)   
  Select uMsg
    Case #HDM_LAYOUT
      result = CallWindowProc_(oldhproc, 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_(oldhproc, hWnd, uMsg, wParam, lParam)   
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure sizeCB()
  ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-50)
EndProcedure

header_h = 40

LoadFont(0,"Georgia",22,#PB_Font_Bold)
LoadFont(1,"Tahoma",10)
LoadFont(2,"Tahoma",12)

LoadImage(100, #PB_Compiler_Home + "examples/Sources/Data/PureBasicLogo.bmp")

OpenWindow(0, 0, 0, 600, 400, "ListIcon Header", #PB_Window_SystemMenu |#PB_Window_ScreenCentered|#PB_Window_SizeGadget)

ListIconGadget(0, 10, 10, 580, 350, "", 200,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect )
AddGadgetColumn(0,1,"",200)
AddGadgetColumn(0,2,"",200)
AddGadgetColumn(0,3,"",200)

For l = 1 To 100
  AddGadgetItem(0, -1, Str(l)+Chr(10) + "Item " + Str(l) + Chr(10)+"Item " + Str(l)+ Chr(10)+"Item " + Str(l))
Next

SetGadgetColor(0,#PB_Gadget_BackColor,$E2FEFE)
SetGadgetFont(0,FontID(2))

header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
oldhproc = SetWindowLongPtr_(header, #GWL_WNDPROC, @headerCB())

SendMessage_(header,#HDM_SETBITMAPMARGIN,0,0)

hilist = ImageList_Create_(200,header_h, #ILC_MASK | #ILC_COLOR32, 0, 5)
SendMessage_(header, #HDM_SETIMAGELIST, #HDSIL_NORMAL, hilist )

CreateImage(0,200,60,24,$FFFFFF)
StartDrawing(ImageOutput(0))
  DrawImage(ImageID(100),0,0,250,60)
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(5,5,"RASHAD",$0000FF,$FFFFFF)
StopDrawing()

i\hbmMask = ImageID(0)
i\hbmColor = ImageID(0)
curHnd = CreateIconIndirect_(i)
ImageList_AddIcon_(hilist , curHnd)
DestroyIcon_(curHnd)

StartDrawing(ImageOutput(0))
  Box(0,0,200,60,$FFFFFF)
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,5,"RASHAD",$000000,$FFFFFF)
  DrawingFont(FontID(1))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,40,"New Tech.",$0000FF,$E0FEFE)
StopDrawing()

i\hbmMask = ImageID(0)
i\hbmColor = ImageID(0)
curHnd = CreateIconIndirect_(i)
ImageList_AddIcon_(hilist , curHnd)
DestroyIcon_(curHnd)

StartDrawing(ImageOutput(0))
  Box(0,0,200,60,$FFFFFF)
  DrawingFont(FontID(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(10,12,"RASHAD",$FF0000,$FFFFFF)
StopDrawing()

i\hbmMask = ImageID(0)
i\hbmColor = ImageID(0)
curHnd = CreateIconIndirect_(i)
ImageList_AddIcon_(hilist , curHnd)
DestroyIcon_(curHnd)

FreeFont(0)
FreeFont(1)
FreeImage(0)

SetHeaderImage(0,0)
SetHeaderImage(1,1)
SetHeaderImage(2,2)

BindEvent(#PB_Event_SizeWindow,@sizeCB())

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
Egypt my love
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: listicon: can header be multi-lines?

Post by morosh »

@RASHAD:
Hello back:
finally, instead of having multi-lines header, I thought that having a vertical (long) header can solve my problem, so I tried your last method, it worked except that image in header (70x80) didn't match the true image (70x80) saved in file (just to check).
So what do you think the problem is?
other: is there any other method for vertical header?

Many thanks in advance

Code: Select all

UsePNGImageEncoder()

EnableExplicit
#HDF_IMAGE = $800
#HDI_IMAGE = $20
#HDSIL_NORMAL = 0
#HDSIL_STATE = 1

Global oldhproc, header_height,header,col,i.ICONINFO
i\fIcon = #True

Procedure SetHeaderImage(Column,index)
  Define VarHeader.HDITEM
  VarHeader\mask = #HDI_IMAGE | #HDI_FORMAT; | #HDI_TEXT
  VarHeader\fmt = #HDF_IMAGE
  VarHeader\iImage = index
  SendMessage_(header, #HDM_SETITEM, Column, @VarHeader)
EndProcedure

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

Procedure sizeCB()
  ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-50)
EndProcedure

LoadFont(0,"Arial",30)
LoadFont(2,"Tahoma",12)

Define Dim title.s(5), k.a, l.a, hilist.l, curHnd.l

Restore label1
For k=1 To 5
  Read.s title(k)
Next

OpenWindow(0, 0, 0, 600, 400, "ListIcon Header", #PB_Window_SystemMenu |#PB_Window_ScreenCentered|#PB_Window_SizeGadget)
ListIconGadget(0, 10, 10, 580, 350, "", 70,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect )
AddGadgetColumn(0,1,"",70)
AddGadgetColumn(0,2,"",70)
AddGadgetColumn(0,3,"",70)
AddGadgetColumn(0,4,"",70)

For l = 1 To 100
  AddGadgetItem(0, -1, Str(l)+Chr(10) + "Item " + Str(l) + Chr(10)+"Item " + Str(l)+ Chr(10)+"Item " + Str(l))
Next

SetGadgetColor(0,#PB_Gadget_BackColor,$E2FEFE)
SetGadgetFont(0,FontID(2))

header_height = 80
header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
oldhproc = SetWindowLongPtr_(header, #GWL_WNDPROC, @headerCB())
SendMessage_(header,#HDM_SETBITMAPMARGIN,0,0)
hilist = ImageList_Create_(200,header_height, #ILC_MASK | #ILC_COLOR32, 0, 5)
SendMessage_(header, #HDM_SETIMAGELIST, #HDSIL_NORMAL, hilist )

CreateImage(0,70,80,24,$FFFFFF)
For k=1 To 5
  StartDrawing(ImageOutput(0))
  Box(0,0,70,80,$ffffff)
  DrawingFont(FontID(0))
;  DrawingMode(#PB_2DDrawing_Transparent)
  DrawRotatedText(50,10,title(k),270,$0000FF)
  StopDrawing()
  SaveImage(0,"test.png",#PB_ImagePlugin_PNG)
  i\hbmMask = ImageID(0)
  i\hbmColor = ImageID(0)
  curHnd = CreateIconIndirect_(i)
  ImageList_AddIcon_(hilist , curHnd)
  DestroyIcon_(curHnd)
Next

SetHeaderImage(0,0)
SetHeaderImage(1,1)
SetHeaderImage(2,2)
SetHeaderImage(3,3)
SetHeaderImage(4,4)

BindEvent(#PB_Event_SizeWindow,@sizeCB())

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

DataSection
  label1:
  Data.s "aaaaa","bbbbb","cccccc","ddddd","eeeee"
EndDataSection
PureBasic: Surprisingly simple, diabolically powerful
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: listicon: can header be multi-lines?

Post by RASHAD »

Hi morosh
The width & height of the ImageList should be the same as the items added or the item will be stretched or compressed accordingly

Code: Select all

hilist = ImageList_Create_(70,80, #ILC_MASK | #ILC_COLOR32, 0, 5)
Egypt my love
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: listicon: can header be multi-lines?

Post by morosh »

Thank you very much

awesome as always!!!
PureBasic: Surprisingly simple, diabolically powerful
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: listicon: can header be multi-lines?

Post by Kwai chang caine »

Thanks RASHAD for this two codes 8)
The first not works without XP theme :wink:
ImageThe happiness is a road...
Not a destination
Denis
Enthusiast
Enthusiast
Posts: 704
Joined: Fri Apr 25, 2003 5:10 pm
Location: Doubs - France

Re: listicon: can header be multi-lines?

Post by Denis »

with PB 5.61 or 5.71 beta 1 :
It doesn't work for me under 64 bit (with theme or not) but it's Ok on x86.

Nothing appear into the header with code of CELTIC88 or with the same modified by RASHAD.


Microsoft Windows 10 Famille Build : 17134 (64 bits)
Intel(R) Core(TM) i5-7400 CPU @ 3.00GHz (4 coeurs)
NVIDIA GeForce GTX 1060 3GB
memory : 8 Go
A+
Denis
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: listicon: can header be multi-lines?

Post by RASHAD »

morosh,KCC & Denis
Thanks guys
Next for PB x86 - x64 with or without theme

Code: Select all

Global oldhproc,oldCB, header,header_h

Global Dim subtext.s(5,1)
subtext.s(0,0) = "Line 1"
subtext.s(0,1) = "Line 2"
subtext.s(1,0) = "Line 3"
subtext.s(1,1) = "Line 4"
subtext.s(2,0) = "Line 5"
subtext.s(2,1) = "Line 6"
subtext.s(3,0) = "Line 7"
subtext.s(3,1) = "Line 8"

Procedure headerCB(hWnd, uMsg, wParam, lParam)   
  Select uMsg
    Case #HDM_LAYOUT
      result = CallWindowProc_(oldhproc, 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
      SendMessage_(GadgetID(0), #LVM_SETCOLUMNWIDTH, 3,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
   
    Default
      result = CallWindowProc_(oldhproc, hWnd, uMsg, wParam, lParam)   
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure liCB(hWnd, uMsg, wParam, lParam)
  Result = CallWindowProc_(oldCB,hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #WM_NOTIFY
      *tNMHDR.NMHDR=lParam
      Select *tNMHDR\code
        Case #NM_CUSTOMDRAW
          *tNMCustomDraw.NMLVCUSTOMDRAW = lParam
          Select *tNMCustomDraw\nmcd\dwDrawStage
            Case #CDDS_PREPAINT               
             If *tNMHDR\hwndFrom = Header:ProcedureReturn #CDRF_NOTIFYITEMDRAW:EndIf
            Case #CDDS_ITEMPREPAINT
              ProcedureReturn #CDRF_NOTIFYPOSTPAINT
            Case #CDDS_ITEMPOSTPAINT
              If *tNMCustomDraw\nmcd\uItemState & #CDIS_SELECTED
                DrawFrameControl_(*tNMCustomDraw\nmcd\hdc, *tNMCustomDraw\nmcd\rc, #DFC_BUTTON,#DFCS_FLAT| #DFCS_BUTTONPUSH|#DFCS_PUSHED)
                InflateRect_(*tNMCustomDraw\nmcd\rc,-2,-2)
              Else
                DrawFrameControl_(*tNMCustomDraw\nmcd\hdc, *tNMCustomDraw\nmcd\rc, #DFC_BUTTON,#DFCS_FLAT| #DFCS_BUTTONPUSH)
              EndIf
              SetBkMode_(*tNMCustomDraw\nmcd\hdc,#TRANSPARENT)
              SetTextColor_(*tNMCustomDraw\nmcd\hdc,$0008FD)
              SelectObject_(*tNMCustomDraw\nmcd\hdc,FontID(0))
              *tNMCustomDraw\nmcd\rc\left + 4                 
              DrawText_(*tNMCustomDraw\nmcd\hdc, subtext.s(*tNMCustomDraw\nmcd\dwItemSpec,0 ), -1, *tNMCustomDraw\nmcd\rc, 0 )
              SetTextColor_(*tNMCustomDraw\nmcd\hdc,$FD2400)
              SelectObject_(*tNMCustomDraw\nmcd\hdc,FontID(1))
              *tNMCustomDraw\nmcd\rc\top + 24
              DrawText_(*tNMCustomDraw\nmcd\hdc, subtext.s(*tNMCustomDraw\nmcd\dwItemSpec ,1), -1, *tNMCustomDraw\nmcd\rc, 0 )
              ProcedureReturn #CDRF_NEWFONT
          EndSelect          
               
      EndSelect
  EndSelect
 
  ProcedureReturn Result
EndProcedure

Procedure sizeCB()
  ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-50)
  SendMessage_(GadgetID(0), #LVM_SETCOLUMNWIDTH, 3,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
EndProcedure

LoadFont(0,"Tahoma",16, #PB_Font_Underline)
LoadFont(1,"Georgia",12)

header_h = 45
OpenWindow(0, 0, 0, 600, 400, "ListIcon Header",
           #PB_Window_SystemMenu |#PB_Window_ScreenCentered|#PB_Window_SizeGadget)

ListIconGadget(0, 10, 10, 580, 350, "", 100,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect )
AddGadgetColumn(0, 1, "", 100)
AddGadgetColumn(0, 2, "", 100)
AddGadgetColumn(0, 3, "", 100)

header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)


oldhproc = SetWindowLongPtr_(header, #GWL_WNDPROC, @headerCB())
oldCB = SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, @liCB())
SendMessage_(GadgetID(0), #LVM_SETCOLUMNWIDTH, 3,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)

BindEvent(#PB_Event_SizeWindow,@sizeCB())
Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
Last edited by RASHAD on Fri Aug 17, 2018 9:36 am, edited 1 time in total.
Egypt my love
Denis
Enthusiast
Enthusiast
Posts: 704
Joined: Fri Apr 25, 2003 5:10 pm
Location: Doubs - France

Re: listicon: can header be multi-lines?

Post by Denis »

it's Ok now RASHAD :wink:
A+
Denis
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: listicon: can header be multi-lines?

Post by RASHAD »

Hi guys
Previous post updated
Egypt my love
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: listicon: can header be multi-lines?

Post by Kwai chang caine »

Perfect RASHAD a great amelioration, like the good wine :mrgreen:
Works perfect W10 x86 / v5.62 x86 without xp theme
Thanks a lot for sharing 8)
ImageThe happiness is a road...
Not a destination
Post Reply