PureBasic Forums - English

Posted: **Thu Aug 09, 2018 7:26 pm**

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

Posted: **Thu Aug 09, 2018 8:15 pm**

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

Posted: **Fri Aug 10, 2018 2:48 pm**

#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

Posted: **Fri Aug 10, 2018 6:15 pm**

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

Posted: **Fri Aug 10, 2018 7:47 pm**

Hi morosh
Modifying the code by CELTIC88

Too much headache

And the effect of clicking the header item not OK
I still prefer my tech. so simple and so flexible

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

Posted: **Tue Aug 14, 2018 1:54 pm**

@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

Posted: **Tue Aug 14, 2018 2:01 pm**

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)

Posted: **Tue Aug 14, 2018 2:10 pm**

Thank you very much

awesome as always!!!

Posted: **Thu Aug 16, 2018 6:37 pm**

Thanks RASHAD for this two codes

The first not works without XP theme

Posted: **Thu Aug 16, 2018 7:01 pm**

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

Posted: **Thu Aug 16, 2018 10:16 pm**

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

Posted: **Fri Aug 17, 2018 5:02 am**

it's Ok now RASHAD

Posted: **Fri Aug 17, 2018 9:37 am**

Hi guys
Previous post updated

Posted: **Sat Aug 18, 2018 4:34 pm**

Perfect RASHAD a great amelioration, like the good wine

Works perfect W10 x86 / v5.62 x86 without xp theme
Thanks a lot for sharing

PureBasic Forums - English

listicon: can header be multi-lines?

listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?

Re: listicon: can header be multi-lines?