It is currently Sun Sep 23, 2018 3:19 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 14 posts ] 
Author Message
 Post subject: listicon: can header be multi-lines?
PostPosted: Thu Aug 09, 2018 7:26 pm 
Offline
Enthusiast
Enthusiast

Joined: Wed Aug 03, 2011 4:52 am
Posts: 206
Location: Beirut, Lebanon
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


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Thu Aug 09, 2018 8:15 pm 
Offline
Addict
Addict

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3069
Hi morosh
#1 :
Code:
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:
#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


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Fri Aug 10, 2018 2:48 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Sep 17, 2015 3:39 pm
Posts: 111
:D

#3

Code:
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..


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Fri Aug 10, 2018 6:15 pm 
Offline
Enthusiast
Enthusiast

Joined: Wed Aug 03, 2011 4:52 am
Posts: 206
Location: Beirut, Lebanon
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


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Fri Aug 10, 2018 7:47 pm 
Offline
Addict
Addict

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3069
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:

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:
#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


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Tue Aug 14, 2018 1:54 pm 
Offline
Enthusiast
Enthusiast

Joined: Wed Aug 03, 2011 4:52 am
Posts: 206
Location: Beirut, Lebanon
@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:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Tue Aug 14, 2018 2:01 pm 
Offline
Addict
Addict

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3069
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:
hilist = ImageList_Create_(70,80, #ILC_MASK | #ILC_COLOR32, 0, 5)

_________________
Egypt my love


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Tue Aug 14, 2018 2:10 pm 
Offline
Enthusiast
Enthusiast

Joined: Wed Aug 03, 2011 4:52 am
Posts: 206
Location: Beirut, Lebanon
Thank you very much

awesome as always!!!

_________________
PureBasic: Surprisingly simple, diabolically powerful


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Thu Aug 16, 2018 6:37 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4263
Location: Lyon - France
Thanks RASHAD for this two codes 8)
The first not works without XP theme :wink:

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Thu Aug 16, 2018 7:01 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Fri Apr 25, 2003 5:10 pm
Posts: 460
Location: France (Doubs)
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


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Thu Aug 16, 2018 10:16 pm 
Offline
Addict
Addict

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3069
morosh,KCC & Denis
Thanks guys
Next for PB x86 - x64 with or without theme
Code:
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

_________________
Egypt my love


Last edited by RASHAD on Fri Aug 17, 2018 9:36 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Fri Aug 17, 2018 5:02 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Fri Apr 25, 2003 5:10 pm
Posts: 460
Location: France (Doubs)
it's Ok now RASHAD :wink:

_________________
A+
Denis


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Fri Aug 17, 2018 9:37 am 
Offline
Addict
Addict

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3069
Hi guys
Previous post updated

_________________
Egypt my love


Top
 Profile  
Reply with quote  
 Post subject: Re: listicon: can header be multi-lines?
PostPosted: Sat Aug 18, 2018 4:34 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4263
Location: Lyon - France
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


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 14 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 9 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye