will man auch die Liste selbst ändern , geschieht dies in der Regel in einem MainCallback, das Prinzip ist gleich.
für eigene Anwendungen müssen natürlich Farben, Ausrichtung etc angepasst werden.
In diesem Beispiel werden nur die Grundfunktionen gezeigt. Mehr geht immer.
Ich empfehle für jede Liste einen eigenen Callback, das macht die Wartung übersichtlicher.
Code: Alles auswählen
;Demo Header Ownerdraw !!! by HJBremer Windows 10 + PB 5.70 x86 + PB 5.72 + 6.00 Beta 5 x64
;RightClick zeigt Spaltenbreite an
;EnableExplicit
#window = 10
#liste1 = 20
#liste2 = 30
UseJPEGImageDecoder()
Global headimgid1 = LoadImage(1, #PB_Compiler_Home + "Examples\3D\Data\Textures\snow_1024.jpg")
Global headimgid2 = LoadImage(2, #PB_Compiler_Home + "Examples\3D\Data\Textures\clouds.jpg")
Global fontStd = LoadFont(#PB_Any, "Tahoma", 11)
Global fontmini = LoadFont(#PB_Any, "Arial", 10)
Global fontBold = LoadFont(#PB_Any, "Arial", 11, #PB_Font_Bold)
Procedure.i ListIconRedraw(pbnr, flag)
;für Daten laden, sonst wird bei jedem AddItem neu gezeichnet und das sieht sch... aus
;flag: #False oder #True (0 oder 1)
SendMessage_(GadgetID(pbnr), #WM_SETREDRAW, flag, 0)
If flag: InvalidateRect_(GadgetID(pbnr), 0, #True): EndIf
EndProcedure
Procedure.i ListIconSetAlign(pbnr, col, align)
;Align: #LVCFMT_CENTER, #LVCFMT_LEFT, #LVCFMT_RIGHT
Protected lv.LV_COLUMN\mask = #LVCF_FMT : lv\fmt = align
Select align
Case #PB_Text_Right: lv\fmt = #LVCFMT_RIGHT
Case #PB_Text_Center: lv\fmt = #LVCFMT_CENTER
EndSelect
SendMessage_(GadgetID(pbnr), #LVM_SETCOLUMN, col, lv)
EndProcedure
Procedure.i ListIconGetHeaderItem(header)
;wo ist die Maus im Header ? wird im Callback gebraucht
Protected hdhit.HD_HITTESTINFO
GetCursorPos_(hdhit\pt)
ScreenToClient_(header, hdhit\pt)
SendMessage_(header,#HDM_HITTEST,0, hdhit)
ProcedureReturn hdhit\iItem
EndProcedure
;-
Procedure.i Liste1_Callback(hwnd, msg, wParam, lParam)
;hwnd ist GadgetId eines ListIcongadgets
;hier wird nur der Header verarbeitet, manch anderes ist natürlich auch möglich
Static showWidthFlag
Protected *nmhdr.NMHDR, *nmcd.NMCUSTOMDRAW, hditem.HDITEM, size.SIZE
Protected column, hitcol, backbrush, brush, align, text$, t1$, t2$
Protected drawtextflags = #DT_END_ELLIPSIS|#DT_VCENTER|#DT_SINGLELINE
Protected headerBackColor = $FFFFB9, headerhitcolor = $90FFAA ;$DFFFFF $C4CAA7 $90F355
Protected pbnr = GetDlgCtrlID_(hwnd) ;z.B. #liste1
Protected oldptr = GetProp_(hwnd, @"Liste1") ;siehe auch SetCallback
Protected result = CallWindowProc_(oldptr, hwnd, msg, wParam, lParam)
If msg = #WM_NCDESTROY : RemoveProp_(hwnd, @"Liste1") ;Liste wird zerstört, Prop löschen
ElseIf msg = #WM_NOTIFY
*nmhdr = LParam
If *nmhdr\code = #NM_CUSTOMDRAW ;nur für Header; Customdraw für Liste im MainCallback
*nmcd = LParam ;:Debug "headerhwnd = " + *nmcd\hdr\hwndFrom
With *nmcd
Select \dwDrawStage
Case #CDDS_PREPAINT: ProcedureReturn #CDRF_NOTIFYITEMDRAW
Case #CDDS_ITEMPREPAINT
column = \dwItemSpec : ;Debug "Col: "+column ;HeaderColumn, ist besser zu lesen
;Background, jede Column könnte eigene Farbe haben
hitcol = ListIconGetHeaderItem(\hdr\hwndFrom) ;wo ist Maus für Highlight ?
backbrush = headerBackColor
If column = 5: backbrush = #Red: EndIf ;<--- andere Farbe
If hitcol = column: backbrush = headerhitcolor: EndIf
brush = CreateSolidBrush_(backbrush) ;SolidBrush erstellen für Background
FillRect_(\hdc, \rc, brush)
DeleteObject_(brush) ;Brush immer löschen
;Rahmen darüber, ab column 1 rc\left-1 sonst optisch dicke Trennbalken
If column : \rc\left-0 : EndIf
brush = GetStockObject_(#LTGRAY_BRUSH) ; StockObject braucht man nicht löschen
FrameRect_(\hdc, \rc, brush) ; oder #DKGRAY_BRUSH
InflateRect_(\rc,-1,-1) ; Rechteck kleiner für Selected + Text
If \uItemState & #CDIS_SELECTED = #CDIS_SELECTED ; wenn Maus gedrückt
FrameRect_(\hdc, \rc, brush)
EndIf
;Textfarbe + Font + align je nach Wunsch
SetTextColor_(\hdc, #Black) ;Vorgabe Textfarbe
SelectObject_(\hdc, FontID(fontStd)) ;Vorgabe Textfont
Select column
Case 0: SetTextColor_(\hdc, #Red)
Case 1: align = #DT_CENTER
Case 2: SelectObject_(\hdc, FontID(fontBold))
Case 3: SetTextColor_(\hdc, #Blue)
Case 4: SetTextColor_(\hdc, #Blue) : align = #DT_CENTER : SelectObject_(\hdc, FontID(fontmini))
Case 5: SetTextColor_(\hdc, #Yellow) : align = #DT_CENTER : SelectObject_(\hdc, FontID(fontmini))
If hitcol = 5: SetTextColor_(\hdc, #Blue): EndIf
EndSelect
;align = #DT_CENTER ;alle zentriert wenn gewünscht (nur Header)
;TextAusrichtung holen, ausser align wurde oben gesetzt
If align = 0
hditem\mask = #HDI_FORMAT
SendMessage_(\hdr\hwndFrom, #HDM_GETITEM, column, hditem)
If hditem\fmt & #HDF_RIGHT : align = #DT_RIGHT : EndIf ; Drawtext Konstanten haben
If hditem\fmt & #HDF_CENTER : align = #DT_CENTER : EndIf ; andere Werte als Header
EndIf
;da Text durch Brush übermalt, Text holen + neu schreiben
text$ = GetGadgetItemText(pbnr, -1, column) ;Text aus Header holen
\rc\top + 1 ; oberer Rand
\rc\left + 7 ; linker Rand
\rc\right - 7 ; rechter Rand
If showWidthFlag ;Spaltenbreite anzeigen, gesetzt durch RightClick im Header
text$ = Str(column) + ", " + Str(SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, column, 0))
align = 0: \rc\left - 4: \rc\right + 6
EndIf
;Text
SetBkMode_(\hdc, #TRANSPARENT)
If FindString(text$, #LF$)
DrawText_(\hdc, @text$, Len(text$), \rc, #DT_END_ELLIPSIS|align)
Else
If column = 2
t1$ = StringField(text$,1,",") + " "
t2$ = StringField(text$,2,",") + " "
DrawText_(\hdc, @t1$, Len(t1$), \rc, drawtextflags)
GetTextExtentPoint32_(\hdc, @t1$, Len(t1$), size)
\rc\left + size\cx: \rc\top - 2
SetBkMode_(\hdc, #OPAQUE)
SetBkColor_(\hdc, #Yellow)
SetTextColor_(\hdc, #Gray)
SelectObject_(\hdc, FontID(fontStd))
DrawText_(\hdc, @t2$, Len(t2$), \rc, drawtextflags)
Else
DrawText_(\hdc, @text$, Len(text$), \rc, drawtextflags|align)
EndIf
EndIf
ProcedureReturn #CDRF_SKIPDEFAULT
EndSelect ;von Select \dwDrawStage
EndWith ;von *nmcd
ElseIf *nmhdr\code = #HDN_BEGINTRACK : ;Debug "#HDN_BEGINTRACK"
ElseIf *nmhdr\code = #HDN_ENDTRACK : ;Debug "#HDN_ENDTRACK"
ElseIf *nmhdr\code = #NM_RCLICK : ;Debug "#NM_RCLICK"
CompilerIf #PB_Compiler_Debugger ; -> weglassen wenn es in die Exedatei soll
showWidthFlag ! 1 ; XOR: 0 ! 1 = 1 ; 1 ! 1 = 0
InvalidateRect_(hwnd, 0, #True) ; erzwingt Neuzeichnen der Liste
If showWidthFlag = 0
Debug "Liste: " + pbnr
For column = 0 To GetGadgetAttribute(pbnr, #PB_ListIcon_ColumnCount) - 1
Debug "Col: " + Str(column) + " = " + GetGadgetItemAttribute(pbnr, 0, #PB_ListIcon_ColumnWidth, column)
Next
EndIf
CompilerEndIf
ElseIf *nmhdr\code = #HDN_ITEMCLICK : ;Debug "#HDN_ITEMCLICK" ; hier ev. Sortieren
ElseIf *nmhdr\code = #HDN_ITEMDBLCLICK : ;Debug "#HDN_ITEMDBLCLICK"
ElseIf *nmhdr\code = #HDN_ITEMCHANGING : ;Debug "#HDN_ITEMCHANGING"
ElseIf *nmhdr\code = #HDN_ITEMCHANGED : ;Debug "#HDN_ITEMCHANGED"
ElseIf *nmhdr\code = #NM_RELEASEDCAPTURE : ;Debug "#NM_RELEASEDCAPTURE"
ElseIf *nmhdr\code = #HDN_ENDDRAG : ;Debug "#HDN_ENDDRAG"
ElseIf *nmhdr\code = #HDN_BEGINDRAG : ;Debug "#HDN_BEGINDRAG"
ElseIf *nmhdr\code = -316 : ;Debug "#HDN_ITEMSTATEICONCLICK"
ElseIf *nmhdr\code = -530 : ;Debug "Tooltip Info ?"
ElseIf *nmhdr\code = -23 : ;unbekannt
Else : Debug "sonstige hdrcodes Liste1 " + *nmhdr\code
EndIf ;von *nmhdr\code = #NM_CUSTOMDRAW
Else ;: Debug msg
EndIf ;von Msg
ProcedureReturn result
EndProcedure
Procedure.i Liste2_Callback(hwnd, msg, wParam, lParam)
;hwnd ist GadgetId eines ListIcongadgets
;hier wird nur der Header verarbeitet
Protected *nmhdr.NMHDR, *nmcd.NMCUSTOMDRAW, hditem.HDITEM, size.SIZE
Protected column, hitcol, backbrush, brush, align, text$, t1$, t2$
Protected drawtextflags = #DT_END_ELLIPSIS|#DT_VCENTER|#DT_SINGLELINE
Protected pbnr = GetDlgCtrlID_(hwnd) ;z.B. #liste2
Protected oldptr = GetProp_(hwnd, @"Liste2") ;
Protected result = CallWindowProc_(oldptr, hwnd, msg, wParam, lParam)
If msg = #WM_NCDESTROY : RemoveProp_(hwnd, @"Liste2") ;Liste wird zerstört, Prop löschen
ElseIf msg = #WM_NOTIFY
*nmhdr = LParam
If *nmhdr\code = #NM_CUSTOMDRAW ;nur für Header; Customdraw für Liste im MainCallback
*nmcd = LParam ;:Debug "headerhwnd = " + *nmcd\hdr\hwndFrom
With *nmcd
Select \dwDrawStage
Case #CDDS_PREPAINT: ProcedureReturn #CDRF_NOTIFYITEMDRAW
Case #CDDS_ITEMPREPAINT
column = \dwItemSpec : ;Debug "Col: "+column ;HeaderColumn, ist besser zu lesen
;Background, jede Column könnte eigene Farbe/Brush haben
hitcol = ListIconGetHeaderItem(\hdr\hwndFrom) ;wo ist Maus für Highlight ?
backbrush = headimgid1
If hitcol = column: backbrush = headimgid2: EndIf
brush = CreatePatternBrush_(backbrush) ;Brush erstellen für Background
FillRect_(\hdc, \rc, brush)
DeleteObject_(brush) ;Brush immer löschen
;Rahmen darüber, ab column 1 rc\left-1 sonst optisch dicke Trennbalken
If column : \rc\left-1 : EndIf
brush = GetStockObject_(#GRAY_BRUSH) ; StockObject braucht man nicht löschen
FrameRect_(\hdc, \rc, brush) ; oder #DKGRAY_BRUSH
InflateRect_(\rc,-2,-2) ; Rechteck kleiner für Selected + Text
If \uItemState & #CDIS_SELECTED = #CDIS_SELECTED ; wenn Maus gedrückt
FrameRect_(\hdc, \rc, brush)
EndIf
;Textfarbe + Font + align je nach Wunsch
SetTextColor_(\hdc, #Black) ;Vorgabe Textfarbe
SelectObject_(\hdc, FontID(fontStd)) ;Vorgabe Textfont
Select column
Case 0: SetTextColor_(\hdc, #Red)
Case 1: SelectObject_(\hdc, FontID(fontBold))
Case 3: SetTextColor_(\hdc, #Blue)
EndSelect
;align = #DT_CENTER ;alle zentriert wenn gewünscht (nur Header)
;TextAusrichtung holen, ausser align wurde oben gesetzt
If align = 0
hditem\mask = #HDI_FORMAT
SendMessage_(\hdr\hwndFrom, #HDM_GETITEM, column, hditem)
If hditem\fmt & #HDF_RIGHT : align = #DT_RIGHT : EndIf ; Drawtext Konstanten haben
If hditem\fmt & #HDF_CENTER : align = #DT_CENTER : EndIf ; andere Werte als Header
EndIf
;da Text durch Brush übermalt, Text holen + neu schreiben
text$ = GetGadgetItemText(pbnr, -1, column) ;Text aus Header holen
\rc\top + 1 ; oberer Rand
\rc\left + 7 ; linker Rand
\rc\right - 7 ; rechter Rand
;Text
SetBkMode_(\hdc, #TRANSPARENT)
If FindString(text$, #LF$)
DrawText_(\hdc, @text$, Len(text$), \rc, #DT_END_ELLIPSIS|align)
Else
If column = 2
t1$ = StringField(text$,1,",") + " "
t2$ = StringField(text$,2,",") + " "
SetTextColor_(\hdc, #Blue)
DrawText_(\hdc, @t1$, Len(t1$), \rc, drawtextflags)
GetTextExtentPoint32_(\hdc, @t1$, Len(t1$), size)
\rc\left + size\cx: \rc\top - 2
SetTextColor_(\hdc, #Magenta)
DrawText_(\hdc, @t2$, Len(t2$), \rc, drawtextflags)
Else
DrawText_(\hdc, @text$, Len(text$), \rc, drawtextflags|align)
EndIf
EndIf
ProcedureReturn #CDRF_SKIPDEFAULT
EndSelect ;von Select \dwDrawStage
EndWith ;von *nmcd
ElseIf *nmhdr\code = #NM_RCLICK ;: Debug "#NM_RCLICK"
ElseIf *nmhdr\code = #HDN_ITEMCLICK : ;Debug "#HDN_ITEMCLICK" ; hier ev. Sortieren
Else : ;Debug "sonstige hdrcodes " + *nmhdr\code
EndIf ;von *nmhdr\code = #NM_CUSTOMDRAW
EndIf ;von Msg
ProcedureReturn result
EndProcedure
Procedure.i Listen_SetCallback(pbnr)
Protected oldpointer, pbid = GadgetID(pbnr)
Protected headerfont, header = SendMessage_(pbid, #LVM_GETHEADER, 0, 0)
SetWindowTheme_(pbid, @"Explorer", 0) ;sieht besser aus
SetGadgetFont(pbnr, FontID(fontStd)) ;muß vor Set Headerfont stehen !!!!
SetGadgetColor(pbnr, #PB_Gadget_BackColor, $D5FFFF) ;$FDE6BD, $DFFFFF
Select pbnr
Case #liste1:
headerfont = LoadFont(#PB_Any, "Arial", 20)
oldpointer = SetWindowLongPtr_(pbid, #GWL_WNDPROC, @Liste1_Callback())
SetProp_(pbid, @"Liste1", oldpointer) ;subclassing ListIconGadget
Case #liste2:
headerfont = LoadFont(#PB_Any, "Arial", 14)
oldpointer = SetWindowLongPtr_(pbid, #GWL_WNDPROC, @Liste2_Callback())
SetProp_(pbid, @"Liste2", oldpointer)
SetGadgetColor(pbnr, #PB_Gadget_LineColor, #Gray)
EndSelect
;Font bestimmt die Höhe des Headers, im ListIconCallback muß man dann Font ändern !!!
;via Setfont ist sehr viel einfacher, als mit HDLayout
SendMessage_(header, #WM_SETFONT, FontID(headerfont), #True): FreeFont(headerfont)
EndProcedure
Define j, nr = 1000
Define listiconflag = #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_HeaderDragDrop
OpenWindow(#window, 300, 50, 800, 700, "ListIconGadget header callback")
ListIconGadget(#liste1, 10, 10, 780, 400, "Check", 60, listiconflag)
AddGadgetColumn(#liste1, 1, "Name", 110)
AddGadgetColumn(#liste1, 2, "Addresse, Straße", 300)
AddGadgetColumn(#liste1, 3, "Zahl", 55)
AddGadgetColumn(#liste1, 4, "Nummer", 70)
AddGadgetColumn(#liste1, 5, "Preis kg" + #LF$ + "Euro", 70)
AddGadgetColumn(#liste1, 6, "Menge", 83)
ListIconSetAlign(#liste1, 3, #PB_Text_Right)
ListIconSetAlign(#liste1, 4, #PB_Text_Center)
ListIconSetAlign(#liste1, 5, #PB_Text_Right)
ListIconSetAlign(#liste1, 6, #PB_Text_Center)
Listen_SetCallback(#liste1)
;Daten laden
ListIconRedraw(#liste1, 0)
For j = 1 To 40
nr + 1:AddGadgetItem(#liste1, -1, "Test" + #LF$ + "Harry Rannit" + #LF$ + "12 Parliament Way, Battle " + #LF$ + Str(nr) + #LF$ + Str(j) + #LF$ + "333,44")
nr + 1:AddGadgetItem(#liste1, -1, "Test" + #LF$ + "Ginger Broke" + #LF$ + "130 PureBasic Road, BigTown" + #LF$ + Str(nr) + #LF$ + Str(j) + #LF$ + "33,44" + #LF$ + Str(j))
Next
ListIconRedraw(#liste1, 1)
;Liste 2 ohne ReDraw
ListIconGadget(#liste2, 10, 420, 450, 220, "Nummer", 80, listiconflag)
AddGadgetColumn(#liste2, 1, "Ort", 115)
AddGadgetColumn(#liste2, 2, "Name, Vorname", 150)
AddGadgetColumn(#liste2, 3, "Telefon", 83)
ListIconSetAlign(#liste2, 0, #PB_Text_Center)
ListIconSetAlign(#liste2, 3, #PB_Text_Right)
Listen_SetCallback(#liste2)
For j = 1 To 20 ;zum Testen 200
AddGadgetItem(#liste2, -1, "22255" + #LF$ + "Hamburg" + #LF$ + "Maier, Otto" + #LF$ + "445588")
AddGadgetItem(#liste2, -1, "24534" + #LF$ + "Neumünster" + #LF$ + "Meier, Bernd" + #LF$ + "33444")
Next
Repeat
Define Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
