Leider habe ich schon wieder mehrere Probleme mit deinem Modul.
Mal abgesehen davon, dass bei AddListColumn() weiterhin bestehende Häkchen aus den Checkboxen verschwinden, so geschieht dasselbe auch, wenn man zum Sortieren auf den Header einer Spalte klickt. Dazu habe ich SortListItems() mal etwas ergänzt:
Code: Alles auswählen
Procedure SortListItems(GadgetID.i, SortCol.i, Flags.l=#False)
; Flags: #UserSort / #Descending / #Ascending / #CaseSensitive / #CaseInSensitive
; SortCol: #Default (if #UserSort)
Protected Row.i, GID.s = Str(GadgetID), ColumnFlag = ListIcon(GID)\Column(Str(SortCol))
; --------------------------------------------------------- Eingefügt vonCebu-Uli ------------------------------
;bewirkt, dass beim Sortieren oder Klick auf den Header einer Tabellenspalte die Checkbox-Inhalte nicht verloren gehen
Protected.i i
For i = 0 To CountGadgetItems(GadgetID)-1
If GetGadgetItemState(GadgetID, i) = #PB_ListIcon_Checked
SetListItemData(GadgetID, i, 1)
Else
SetListItemData(GadgetID, i, 0)
EndIf
Next i
; ------------------------------------------------------------------------------------------------------------------
If ListSize(ListIcon(GID)\Item())
If ColumnFlag & #Integer ;{ Sort Integer
SetSortOrderInteger(GadgetID, Flags, SortCol)
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\SortInteger), TypeOf(ListItemStructure\SortInteger))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\SortInteger), TypeOf(ListItemStructure\SortInteger))
EndIf ;}
ElseIf ColumnFlag & #Float ;{ Sort Float
SetSortOrderFloat(GadgetID, Flags, SortCol)
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\SortFloat), TypeOf(ListItemStructure\SortFloat))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\SortFloat), TypeOf(ListItemStructure\SortFloat))
EndIf ;}
ElseIf ColumnFlag & #UserSort ;{ Sort User
SetSortUserOrder(GadgetID, Flags, SortCol)
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
EndIf
Else ;{ Sort String
If Flags & #UserSort
SetSortUserOrder(GadgetID, Flags, SortCol)
Else
SetSortOrder(GadgetID, Flags, SortCol)
EndIf
If Flags & #Descending
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Descending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
Else
SortStructuredList(ListIcon(GID)\Item(), #PB_Sort_Ascending, OffsetOf(ListItemStructure\Sort), TypeOf(ListItemStructure\Sort))
EndIf ;}
EndIf
ClearGadgetItems(GadgetID)
ForEach ListIcon(GID)\Item()
AddGadgetItem(GadgetID, Row, ListIcon(GID)\Item()\Text)
SetGadgetItemData(GadgetID, Row, ListIcon(GID)\Item()\ItemData)
Row + 1
Next
; --------------------------------------------------------- Eingefügt von Cebu-Uli ------------------------------
;bewirkt, dass beim Sortieren oder Klick auf den Header einer Tabellenspalte die Checkbox-Inhalte nicht verloren gehen
For i = 0 To CountGadgetItems(GadgetID)-1
If GetListItemData(GadgetID, i) = 1
SetGadgetItemState(GadgetID, i, #PB_ListIcon_Checked)
EndIf
Next i
; ------------------------------------------------------------------------------------------------------------------
EndIf
EndProcedure
Wenn man im ListIcon rechts noch Platz neben der letzten Spalte hat und man klickt in diesen Bereich mit Doppelklick, so crasht das Modul in ListIconCallback(), weil dort width > 32767 wird. Das habe ich mit der folgenden Zeile einfach abgefangen:
Das nächste Problem betrifft ebenfalls diese Prozedur. Nach DefineListCallback() funktioniert SetColumnFlag() mit dem Parameter #Hide nicht mehr, ebensowenig wie der Original-PB-Befehl SetGadgetItemAttribute().
Dazu habe ich ebenfalls Änderungen in ListIconCallback() vorgenommen. Deshalb hier die komplette Procedure:
Code: Alles auswählen
Procedure.i ListIcon_CallBack(hWnd, Message, wParam, lParam)
Protected.i Column, x, y, width, height, i
Protected *ListEdit.ListEditStructure = GetWindowLongPtr_(hWnd, #GWL_USERDATA)
Protected *Header.HD_NOTIFY, *nm.NMHDR, *nmhdr.NMHEADER, MouseClick.LVHITTESTINFO, rect.rect
Protected HDItem.HD_ITEM, ColsCount.i = SendMessage_(*ListEdit\HeaderHnd, #HDM_GETITEMCOUNT, 0, 0)
Protected GID.s=Str(*ListEdit\GadgetID), SortDirection.l, Flags.l = ListIcon(GID)\Flags
Protected Result.i = CallWindowProc_(*ListEdit\CallBack, hWnd, Message, wParam, lParam)
Select Message
Case #WM_NOTIFY ;{ ListIcon
If Flags & #Edit ;{ Edit
*nm = lParam
If *nm\hWndFrom = *ListEdit\HeaderHnd
StopListEdit(*ListEdit)
EndIf
EndIf ;}
*nmhdr = lParam ;{ Column NoResize/Hide
If *nmhdr\hdr\code = #HDN_ITEMCHANGING
Column = *nmhdr\iItem
;==========================================================================
;Original
;If ListIcon(GID)\Column(Str(Column)) & #NoResize Or ListIcon(GID)\Column(Str(Column)) & #Hide Or Flags & #NoResize
; Result=#True
;EndIf
;Änderung durch Cebu-Uli
If ListIcon(GID)\Column(Str(Column)) & #NoResize Or Flags & #NoResize
Result=#True
EndIf
If ListIcon(GID)\Column(Str(Column)) & #Hide
Result=#False
EndIf
;===========================================================================
EndIf ;}
*Header = lParam ;{ Header Click
If *Header\hdr\code=#HDN_ITEMCLICK
Column = *Header\iItem
If Not ListIcon(GID)\Column(Str(Column)) & #NoSort
HDItem\mask = #HDI_FORMAT
For i = 0 To ColsCount - 1
If i <> column
SendMessage_(*ListEdit\HeaderHnd, #HDM_GETITEM, i, HDItem)
HDItem\fmt & ~ (#HDF_SORTDOWN | #HDF_SORTUP)
SendMessage_(*ListEdit\HeaderHnd, #HDM_SETITEM, i, HDItem)
EndIf
Next
SendMessage_(*ListEdit\HeaderHnd, #HDM_GETITEM, Column, HDItem)
If HDItem\fmt & #HDF_SORTDOWN
HDItem\fmt & ~ #HDF_SORTDOWN
HDItem\fmt | #HDF_SORTUP
SortDirection = #Descending
Else
HDItem\fmt & ~ #HDF_SORTUP
HDItem\fmt | #HDF_SORTDOWN
SortDirection = #Ascending
EndIf
Flags & ~ (#Ascending|#Descending)
SendMessage_(*ListEdit\HeaderHnd, #HDM_SETITEM, Column, HDItem)
SortListItems(*ListEdit\GadgetID, Column, Flags|SortDirection)
EndIf
EndIf ;}
;}
Case #WM_MOUSEMOVE ;{ Mouse position
If *ListEdit\EditFlag = #False
*ListEdit\lParam = lParam
EndIf ;}
Case #WM_VSCROLL, #WM_HSCROLL, #WM_RBUTTONDOWN, #WM_LBUTTONDOWN ;{
StopListEdit(*ListEdit)
;}
Case #WM_LBUTTONDBLCLK ;{ Left mouse button
If Flags & #Edit
StopListEdit(*ListEdit)
MouseClick\pt\x = *ListEdit\points\x ; \points <- #WM_MOUSEMOVE
MouseClick\pt\y = *ListEdit\points\y
SendMessage_(hWnd, #LVM_SUBITEMHITTEST, 0, MouseClick)
*ListEdit\Row = MouseClick\iitem
*ListEdit\Column = MouseClick\iSubItem
If Not ListIcon(GID)\Column(Str(MouseClick\iSubItem)) & #NoEdit
rect\top = *ListEdit\Column
rect\left = #LVIR_LABEL
SendMessage_(hWnd, #LVM_GETSUBITEMRECT, *ListEdit\Row, rect)
*ListEdit\CellText = GetGadgetItemText(*ListEdit\GadgetID, *ListEdit\Row, *ListEdit\Column)
x = rect\left + 1
y = rect\top + 0
width = rect\right - rect\left - 1
If width > 32767 : width = 32767 : EndIf; <======= Eingefügt von Cebu-Uli, da es bei width > 32767 beim ResizeGadget zum Crash kommt ========
height = rect\bottom - rect\top - 0
ResizeGadget(*ListEdit\StrgID, x, y, width, height)
SetGadgetText(*ListEdit\StrgID, *ListEdit\CellText)
HideGadget(*ListEdit\StrgID, 0)
SetActiveGadget(*ListEdit\StrgID)
*ListEdit\EditFlag = #True
EndIf
EndIf
;}
EndSelect
ProcedureReturn Result
EndProcedure
Das sind natürlich nur meine Lösungsvorschläge. Hat bei mir erst einmal funktioniert, ist aber sicherlich noch nicht genug getestet. Du darfst es gerne besser machen! Ist schließlich dein Modul.
Viele Grüße
Uli
