Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS MacOSX Plugin, MBS MacCocoa Plugin, MBS MacBase Plugin, MBS MacControls Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /MacControls/Listbox and TableView Demos/ListboxTV drop-in/Flat Only/ListBoxTV Database with DataSource
This example is the version from Tue, 20th Aug 2018.
Project "ListBoxTV Database with DataSource.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
DBFileTypes
Filetype special/any
End DBFileTypes
Class DatabaseBrowserWin Inherits Window
Control dbRowsList Inherits ListBoxTV
ControlInstance dbRowsList Inherits ListBoxTV
End Control
Control Label1 Inherits Label
ControlInstance Label1 Inherits Label
End Control
Control dbTablesList Inherits ListBoxTV
ControlInstance dbTablesList Inherits ListBoxTV
EventHandler Sub Change()
// A DB Table has been selected - load its rows into the other listbox
if me.ListIndex >= 0 then
dim tableName as String = me.List (me.ListIndex)
// Fetch the column names from the database table and set up the Listbox columns accordingly
dim rs as RecordSet = mDatabase.FieldSchema ("["+tableName+"]")
if rs = nil or rs.RecordCount = 0 then
// Oops - something went wrong
MsgBox "Can't load that table"
else
// Set up the columns in the listbox
dbRowsList.ColumnCount = rs.RecordCount
dim col as Integer
while not rs.EOF
dbRowsList.Heading(col) = rs.Field("ColumnName")
dbRowsList.Column(col).MinWidthActual = 60
rs.MoveNext
col = col + 1
wend
// Set up the Datasource that'll provide the row contents
dbRowsList.DataSource = new DatabaseTableRowsProvider (mDatabase, tableName)
dbRowsList.Enabled = true
rowsInfoLbl.Text = Str (dbRowsList.ListCount) + " rows"
return ' we're done
end if
end if
// We should only get here if the rows table setup failed
dbRowsList.ColumnCount = 0
dbRowsList.DataSource = nil
dbRowsList.Enabled = false
rowsInfoLbl.Text = ""
End EventHandler
End Control
Control rowsInfoLbl Inherits Label
ControlInstance rowsInfoLbl Inherits Label
End Control
Control tablesInfoLbl Inherits Label
ControlInstance tablesInfoLbl Inherits Label
End Control
EventHandler Sub DropObject(obj As DragItem, action As Integer)
if obj.FolderItemAvailable and obj.FolderItem <> nil then
openDatabase obj.FolderItem
else
beep
end if
End EventHandler
EventHandler Sub Open()
me.AcceptFileDrop DBFileTypes.All
End EventHandler
Private Sub openDatabase(dbFile as FolderItem)
dim db as new REALSQLDatabase
db.DatabaseFile = dbFile
if not db.Connect then
MsgBox "Can't open this db file"
return
end if
//
// We have a DB - set up the left listbox to display the table names
//
mDatabase = db
dbTablesList.DataSource = new DatabaseTablesProvider (db)
dbTablesList.Enabled = true
tablesInfoLbl.Text = Str (dbTablesList.ListCount) + " tables"
End Sub
Property Private mDatabase As Database
End Class
Class DatabaseTablesProvider
Sub Constructor(db as Database)
me.theDatabase = db
End Sub
Function DataSource_Cell(row as Integer, column as Integer) As ListCellTV
return new ListCellTV (tableNames(row))
End Function
Sub DataSource_CellDidUpdate(row as Integer, column as Integer, cell as ListCellTV, updatesText as Boolean, updatesChecked as Boolean)
End Sub
Sub DataSource_CellWillUpdate(row as Integer, column as Integer, cell as ListCellTV, updatesText as Boolean, updatesChecked as Boolean)
End Sub
Sub DataSource_DeleteAllRows()
End Sub
Sub DataSource_MoveColumn(fromIdx as Integer, toIdx as Integer)
End Sub
Sub DataSource_MoveRows(fromIdxs() as Integer, toAboveIdx as Integer)
End Sub
Function DataSource_RowCount() As Integer
// Fetch the table names from the database and return their number
redim tableNames(-1)
dim rs as RecordSet = theDatabase.TableSchema
while not rs.EOF
dim name as String = rs.IdxField(1)
if name.Left(7) <> "sqlite_" then
tableNames.Append name
end if
rs.MoveNext
wend
return tableNames.Ubound + 1
End Function
Function DataSource_RowTag(row as Integer) As Variant
End Function
Sub DataSource_RowTag(row as Integer, assigns tag as Variant)
End Sub
Sub DataSource_SetColumnCount(colCount as Integer)
End Sub
Sub DataSource_SortRows(sorters() as NSSortDescriptorMBS)
End Sub
Property Private tableNames() As String
Property Private theDatabase As Database
End Class
Class DatabaseTableRowsProvider
Sub Constructor(db as Database, tableName as String)
mDatabase = db
mTableName = tableName
mLastFetchedRowNumber = -1
End Sub
Function DataSource_Cell(row as Integer, column as Integer) As ListCellTV
// Return the row's column of the DB table
dim rowValues() as String
// Let's do a little caching to avoid fetching the same row multiple times
if row = mLastFetchedRowNumber then
rowValues = mLastFetchedRowValues
else
mLastFetchedRowNumber = row
dim rs as RecordSet = mDatabase.SQLSelect ("SELECT * FROM ["+mTableName+"] LIMIT 1 OFFSET "+Str(row))
if rs = nil or rs.EOF then
redim mLastFetchedRowValues(-1)
return nil
end if
for i as Integer = 1 to rs.FieldCount
rowValues.Append rs.IdxField(i)
next
mLastFetchedRowValues = rowValues
end if
return new ListCellTV (rowValues (column))
End Function
Sub DataSource_CellDidUpdate(row as Integer, column as Integer, cell as ListCellTV, updatesText as Boolean, updatesChecked as Boolean)
End Sub
Sub DataSource_CellWillUpdate(row as Integer, column as Integer, cell as ListCellTV, updatesText as Boolean, updatesChecked as Boolean)
End Sub
Sub DataSource_DeleteAllRows()
mLastFetchedRowNumber = -1
End Sub
Sub DataSource_MoveColumn(fromIdx as Integer, toIdx as Integer)
End Sub
Sub DataSource_MoveRows(fromIdxs() as Integer, toAboveIdx as Integer)
End Sub
Function DataSource_RowCount() As Integer
// Return the row count of the table
dim rs as RecordSet = mDatabase.SQLSelect ("SELECT COUNT(1) FROM ["+mTableName+"]")
return rs.IdxField(1).IntegerValue
End Function
Function DataSource_RowTag(row as Integer) As Variant
End Function
Sub DataSource_RowTag(row as Integer, assigns tag as Variant)
End Sub
Sub DataSource_SetColumnCount(colCount as Integer)
End Sub
Sub DataSource_SortRows(sorters() as NSSortDescriptorMBS)
End Sub
Property Private mDatabase As Database
Property Private mLastFetchedRowNumber As Integer
Property Private mLastFetchedRowValues() As String
Property Private mTableName As String
End Class
Class ListBoxTV Inherits NSTableControlMBS
ComputedProperty AutoHideScrollBars As Boolean
Sub Set()
if not mHadOpenEvent then
mDelayedHideScrollers = value
else
me.autohidesScrollers = value
end if
End Set
Sub Get()
if not mHadOpenEvent then
return mDelayedHideScrollers
else
return me.autohidesScrollers
end if
End Get
End ComputedProperty
ComputedProperty ColumnCount As Integer
Sub Set()
if not mHadOpenEvent then
mDelayedColumnCount = value
else
if value < 1 then value = 1
dim newUbound as Integer = value-1
if newUbound = mCols.Ubound then
// no change
return
end if
// Add columns
while newUbound > mCols.Ubound
dim c as new ListColumnTV (mSelfRef, mCols.Ubound+1)
mCols.Append c
c.title = Str(mCols.Ubound)
mTableView.addTableColumn c
wend
// Remove columns
while mCols.Ubound > newUbound
mTableView.removeTableColumn (mCols.Pop)
wend
mDataSource.DataSource_SetColumnCount value
_needsReload
end if
End Set
Sub Get()
if not mHadOpenEvent then
return mDelayedColumnCount
else
return mCols.Ubound+1
end if
End Get
End ComputedProperty
ComputedProperty ColumnWidths As String
Sub Set()
if not mHadOpenEvent then
mDelayedColumnWidths = value
else
dim w() as String
for each s as String in value.Split(",")
w.Append s
next
redim w(mCols.Ubound)
if value = "" or w.Ubound <= 0 then
// User has not set any rules for the widths or has only one column - let's use the TableView's auto resizing
mHasDynamicColumnWidths = false
mTableView.columnAutoresizingStyle = mDefaultColumnAutoresizingStyle
else
// User has set explicit rules for the widths - use our own resizing implementation (see '_recalcColumnWidths')
for i as Integer = 0 to mCols.Ubound
dim col as ListColumnTV = mCols(i)
col.WidthExpression = w(i)
next
end if
end if
End Set
Sub Get()
if not mHadOpenEvent then
return mDelayedColumnWidths
else
dim res() as String
for each col as ListColumnTV in mCols
if mMaintainColumnWidths then
res.Append col.WidthExpression
else
res.Append Str (col.WidthActual,"-#")
end if
next
return Join (res, ",")
end if
End Get
End ComputedProperty
ComputedProperty ColumnsResizable As Boolean
Sub Set()
if not mHadOpenEvent then
mDelayedColumnResizing = value
else
me.allowsColumnResizing = value
end if
End Set
Sub Get()
if not mHadOpenEvent then
return mDelayedColumnResizing
else
return me.allowsColumnResizing
end if
End Get
End ComputedProperty
ComputedProperty DataSource As ListBoxTVDataSource
Sub Set()
if value = nil then
value = new ListBoxTV_Support.ListBoxTVStaticDataSource (mSelfRef)
end if
mDataSource = value
mDataSource.DataSource_SetColumnCount mCols.Ubound+1
me.Reload() ' needs to reload without delay, or rowCount won't be inquired before a redraw may occur
End Set
Sub Get()
return mDataSource
End Get
End ComputedProperty
ComputedProperty EnableDrag As Boolean
Sub Set()
mEnableDrag = value
End Set
Sub Get()
return mEnableDrag
End Get
End ComputedProperty
ComputedProperty EnableDragReorder As Boolean
Sub Set()
mEnableDragReorder = value
if value then
mTableView.registerForDraggedTypes Array ("private.EnableDragReorder")
end if
End Set
Sub Get()
return mEnableDragReorder
End Get
End ComputedProperty
ComputedProperty GridLinesHorizontal As Integer
Sub Set()
const NSTableViewDashedHorizontalGridLineMask = 8
dim v as Integer
select case value
case ListBox.BorderDefault, ListBox.BorderNone
v = NSTableViewMBS.NSTableViewGridNone
case ListBox.BorderThinDotted
v = NSTableViewMBS.NSTableViewSolidHorizontalGridLineMask or NSTableViewDashedHorizontalGridLineMask
else
v = NSTableViewMBS.NSTableViewSolidHorizontalGridLineMask
end select
me.TableView.gridStyleMask = (me.TableView.gridStyleMask AND NOT (NSTableViewMBS.NSTableViewSolidHorizontalGridLineMask or NSTableViewDashedHorizontalGridLineMask)) OR v
End Set
Sub Get()
const NSTableViewDashedHorizontalGridLineMask = 8
dim v as Integer = me.TableView.gridStyleMask AND (NSTableViewMBS.NSTableViewSolidHorizontalGridLineMask or NSTableViewDashedHorizontalGridLineMask)
if (v AND NSTableViewDashedHorizontalGridLineMask) <> 0 then
return ListBox.BorderThinDotted
elseif v <> 0 then
return ListBox.BorderThinSolid
else
return ListBox.BorderNone
end if
End Get
End ComputedProperty
ComputedProperty GridLinesVertical As Integer
Sub Set()
dim v as Integer
select case value
case ListBox.BorderDefault, ListBox.BorderNone
v = NSTableViewMBS.NSTableViewGridNone
else
v = NSTableViewMBS.NSTableViewSolidVerticalGridLineMask
end select
me.TableView.gridStyleMask = (me.TableView.gridStyleMask AND NOT NSTableViewMBS.NSTableViewSolidVerticalGridLineMask) OR v
End Set
Sub Get()
dim v as Integer = me.TableView.gridStyleMask AND NSTableViewMBS.NSTableViewSolidVerticalGridLineMask
if v <> 0 then
return ListBox.BorderThinSolid
else
return ListBox.BorderNone
end if
End Get
End ComputedProperty
ComputedProperty HasHeading As Boolean
Sub Set()
if value <> me.HasHeading then
if value then
mTableView.headerView = mHeaderView
else
mTableView.headerView = nil
end if
end if
End Set
Sub Get()
return mTableView.headerView <> nil
End Get
End ComputedProperty
ComputedProperty IntercellSpacing As Integer
Sub Set()
dim ss as new NSSizeMBS
ss.Width = value
ss.Height = value
self.TableView.intercellSpacing = ss
End Set
End ComputedProperty
ComputedProperty ListCount As Integer
Sub Get()
return mDataSource.DataSource_RowCount
End Get
End ComputedProperty
ComputedProperty ListIndex As Integer
Sub Set()
if value >= 0 and value < me.ListCount then
mTableView.selectRowIndexes (NSIndexSetMBS.indexSetWithIndex(value), false)
else
me.DeselectAll
end if
End Set
Sub Get()
if mSelectionCache.count = 0 then
return -1
else
return mSelectionCache.firstIndex
end if
End Get
End ComputedProperty
ComputedProperty MaintainColumnWidths As Boolean
True: Emulate Xojo's algorithm to keep columns sized based on "%" and "*" values in ColumnWidths or Columns(n).WidthExpression.
False: If ColumnWidths is set, the columns are adjusted once. After that, they are maintained by NSTableView's columnAutoresizingStyle property.
Sub Set()
mMaintainColumnWidths = value
End Set
Sub Get()
return mMaintainColumnWidths
End Get
End ComputedProperty
ComputedProperty RequiresSelection As Boolean
Sub Set()
if not mHadOpenEvent then
mDelayedRequiresSelection = value
else
me.allowsEmptySelection = not value
end if
End Set
Sub Get()
if not mHadOpenEvent then
return mDelayedRequiresSelection
else
return not me.allowsEmptySelection
end if
End Get
End ComputedProperty
ComputedProperty ScrollPosition As Integer
Sub Set()
'
End Set
Sub Get()
return 0
End Get
End ComputedProperty
ComputedProperty ScrollbarHorizontal As Boolean
Sub Set()
if not mHadOpenEvent then
mDelayedHorScroller = value
else
me.hasHorizontalScroller = value
end if
End Set
Sub Get()
if not mHadOpenEvent then
return mDelayedHorScroller
else
return me.hasHorizontalScroller
end if
End Get
End ComputedProperty
ComputedProperty ScrollbarVertical As Boolean
Sub Set()
if not mHadOpenEvent then
mDelayedVerScroller = value
else
me.hasVerticalScroller = value
end if
End Set
Sub Get()
if not mHadOpenEvent then
return mDelayedVerScroller
else
return me.hasVerticalScroller
end if
End Get
End ComputedProperty
ComputedProperty SelectionType As Integer
Sub Set()
if not mHadOpenEvent then
mDelayedSelectionType = value
else
mTableView.allowsMultipleSelection = value <> 0
end if
End Set
Sub Get()
if not mHadOpenEvent then
return mDelayedSelectionType
else
if mTableView.allowsMultipleSelection then
return 1
end if
end if
End Get
End ComputedProperty
ComputedProperty SortedColumn As Integer
Sub Set()
// Note: This method should not depress the header, i.e. not indicate sorting, but it does currently. Not perfect, but should work for most cases.
if not mHadOpenEvent then return
// Re-arrange the existing sort descriptors so that the specified column comes first
dim sorters() as NSSortDescriptorMBS = mTableView.sortDescriptors()
for each sorter as NSSortDescriptorMBS in sorters
dim col as Integer = mTableView.columnWithIdentifier (sorter.key)
if col = value then
// found it
dim i as Integer = sorters.IndexOf (sorter)
if i <> 0 then
sorters.Remove i
sorters.Insert 0, sorter
mTableView.setSortDescriptors sorters
end if
return
end if
next
// If there are no sort descriptors for our column, set it from our ListColumnTV
dim col as ListColumnTV = Column(value)
sorters.Insert 0, col.SortDescriptorPrototype
mTableView.setSortDescriptors sorters
End Set
Sub Get()
dim sorters() as NSSortDescriptorMBS = mTableView.sortDescriptors()
if sorters.Ubound >= 0 then
dim firstSorter as NSSortDescriptorMBS = sorters(0)
return mTableView.columnWithIdentifier (firstSorter.key)
end if
End Get
End ComputedProperty
ComputedProperty TextFont As String
Sub Set()
mTextFont = value
_needsReload
End Set
Sub Get()
return mTextFont
End Get
End ComputedProperty
ComputedProperty TextSize As Integer
Sub Set()
mTextSize = value
_needsReload
End Set
Sub Get()
return mTextSize
End Get
End ComputedProperty
ComputedProperty UseContextualClickEvent As Boolean
Set this to True if you want to use the ContextualMenu events.
Sub Set()
mUseContextualClickEvent = value
if value then
mTableView.menu = mContextMenu
else
mTableView.menu = nil
end if
End Set
Sub Get()
return mUseContextualClickEvent
End Get
End ComputedProperty
ComputedProperty UseFocusRing As Boolean
Sub Set()
if value then
me.ScrollView.focusRingType = NSScrollViewMBS.NSFocusRingTypeExterior
else
me.ScrollView.focusRingType = NSScrollViewMBS.NSFocusRingTypeNone
end if
End Set
Sub Get()
return me.ScrollView.focusRingType = NSScrollViewMBS.NSFocusRingTypeExterior
End Get
End ComputedProperty
Const DragReorderPBType = "private.DragReorder"
Const Support_OSX_10_6 = true
Const Version = 5
Enum columnWidthCalcTypes
actual
minimum
maximum
End Enum
Enum columnWidthTypes
absolute
percentage
remain
End Enum
Event CellAction(row as Integer, column as Integer)
End Event
Event CellBackgroundPaint(g As Graphics, row As Integer, column As Integer, textFrame as NSRectMBS, controlView as NSViewMBS) As Boolean
End Event
Event CellClick(row as Integer, column as Integer, x as Integer, y as Integer) As Boolean
End Event
Event CellTextPaint(g As Graphics, row As Integer, column As Integer, x as Integer, y as Integer, textFrame as NSRectMBS, controlView as NSViewMBS) As Boolean
End Event
Event Change()
End Event
Event CollapseRow(row As Integer)
End Event
Event ColumnsMoved(oldColumn as Integer, newColumn as Integer)
End Event
Event ColumnsResized(column as Integer, oldWidth as Integer)
End Event
Event CompareRows(cell1 as ListCellTV, cell2 as ListCellTV, row1 as Integer, row2 as Integer, column as Integer, ByRef result as Integer) As Boolean
End Event
Event ConstructContextualMenu(base as MenuItem, x as Integer, y as Integer, clickedRow as Integer, clickedColumn as Integer, parentMenu as NSMenuMBS) As Boolean
End Event
Event ConstructContextualMenuForHeader(base as MenuItem, x as Integer, y as Integer, clickedColumn as Integer, parentMenu as NSMenuMBS) As Boolean
End Event
Event ContextualMenuAction(hitItem as MenuItem, clickedRow as Integer, clickedColumn as Integer) As Boolean
End Event
Event DenyReorderColumn(fromColumn as Integer, toColumn as Integer) As Boolean
End Event
Event DidResizeCells()
End Event
Event DragReorderColumns(movedColumn as integer, insertColumn as Integer)
End Event
Event DragReorderRows(newPosition as Integer, parentRow as Integer) As Boolean
End Event
Event DragRow(drag as DragItemTV, row as Integer, ByRef operationMask as Integer, ByRef thisAppOnly as Boolean) As Boolean
End Event
Event DropObject(obj as DragItemTV, operationMask as Integer, aboveRow as Integer, draggingInfo as NSDraggingInfoMBS)
End Event
Event ExpandRow(row as Integer)
End Event
Event HeaderPressed(column as Integer) As Boolean
End Event
Event MouseDown(x as Integer, y as Integer) As Boolean
End Event
Event Open()
End Event
Event SortColumn(column as Integer) As Boolean
End Event
Event WillDisplayCell(row as Integer, column as Integer, cell as ListCellTV, textFieldCell as NSCellMBS, tableColumn as NSTableColumnMBS) As Boolean
End Event
Event didTile()
End Event
EventHandler Sub ColumnDidMove(notification as NSNotificationMBS, OldColumn as Integer, NewColumn as Integer)
mInsideHeaderDrag = false
mIgnoreTileEvents = false
dim indexes() as Integer
for each col as ListColumnTV in mCols
col._updateOwnIndex
indexes.Append col.ColumnIndex
next
indexes.SortWith mCols
mDataSource.DataSource_MoveColumn (oldColumn, newColumn)
RaiseEvent ColumnsMoved(oldColumn, newColumn)
End EventHandler
EventHandler Sub ColumnDidResize(notification as NSNotificationMBS, tableColumn as NSTableColumnMBS, OldWidth as Double)
if mInsideHeaderDrag then
mInsideHeaderDrag = false
mIgnoreTileEvents = false
me.updateColumnWidthExpressions
// Does the cursor remain in "Resizing" state? This happens only with Real Studio 2012, however, but not with Xojo 2016.
end if
if not mIgnoreTileEvents then
RaiseEvent ColumnsResized (ListColumnTV(tableColumn).ColumnIndex, oldWidth)
end
End EventHandler
EventHandler Function ConstructContextualMenu(base as MenuItem, x as Integer, y as Integer) As Boolean
'
End EventHandler
EventHandler Function ContextualMenuAction(hitItem as MenuItem) As Boolean
'
End EventHandler
EventHandler Sub DropObject(obj As DragItem, action As Integer)
break
End EventHandler
EventHandler Function MouseDown(x as Integer, y as Integer, Modifiers as Integer) As Boolean
return handleMouseDown (x, y, modifiers)
End EventHandler
EventHandler Sub Open()
me.setDelayedProperties()
me.setupFromInitialValue()
RaiseEvent Open()
End EventHandler
EventHandler Sub SelectionDidChange(notification as NSNotificationMBS)
mSelectionCache = mTableView.selectedRowIndexes()
RaiseEvent Change()
End EventHandler
EventHandler Function acceptDrop(info as NSDraggingInfoMBS, row as Integer, dropOperation as Integer) As Boolean
// Finishes the drop
dim pb as NSPasteboardMBS = info.draggingPasteboard
dim operationMask as Integer = info.draggingSourceOperationMask
// Is this a moved row?
if mEnableDragReorder and info.draggingSource = mTableView then
dim mb as MemoryBlock = pb.dataForType(DragReorderPBType)
if mb <> nil then
dim srcRows() as Integer
for i as Integer = 0 to mb.Size-1 step 4
srcRows.Append mb.Int32Value(i)
next
me.SelectRows srcRows ' makes sure the moved rows are selected because the DragReorderRows event expects that
if not RaiseEvent DragReorderRows (row, -1) then
mDataSource.DataSource_MoveRows (srcRows, row)
end if
return true ' -> drop was successful
end if
end if
// Send it to the DropObject event handler
dim dragItems as new DragItemTV (pb)
RaiseEvent DropObject (dragItems, operationMask, row, info) ' we should pass "Action as Integer" here, but I don't know how that translation from the operationMask is supposed to be done.
End EventHandler
EventHandler Function dataCell(tableColumn as NSTableColumnMBS, row as Int64) As NSCellMBS
if tableColumn = nil then
return nil
end if
dim tcol as ListColumnTV = ListColumnTV(tableColumn)
dim col as Integer = tcol.ColumnIndex
dim myCell as ListCellTV = _cell(row, col)
dim t as Integer = myCell.Type
if t = ListBox.TypeCheckbox or (t = ListBox.TypeDefault and tcol.Type = ListBox.TypeCheckbox) then
// A checkbox cell
static bc as NSButtonCellMBS
if bc = nil then ' we only need to create this once
bc = new NSButtonCellMBS ("x")
declare sub setButtonType lib "Cocoa" selector "setButtonType:" (h as Integer, t as Integer)
setButtonType (bc.Handle, NSButtonMBS.NSSwitchButton)
bc.wraps = false
bc.lineBreakMode = NSParagraphStyleMBS.NSLineBreakByTruncatingTail
end if
return bc
end if
// We return a custom NSTextFieldCell, in order to perform some custom painting in its drawWithFrame event handler.
// We are lazy and re-use the same cell, because we keep getting this event called for each drawn cell, sequentially.
static cc as ListBoxTV_Support.ListDrawCellHandler
if cc = nil then
cc = new ListBoxTV_Support.ListDrawCellHandler (mSelfRef)
cc.editable = true
cc.wraps = false
cc.lineBreakMode = NSParagraphStyleMBS.NSLineBreakByTruncatingTail
end if
return cc
End EventHandler
EventHandler Sub didClickTableColumn(tableColumn as NSTableColumnMBS)
mInsideHeaderDrag = false
mIgnoreTileEvents = false
dim column as Integer = ListColumnTV(tableColumn).ColumnIndex
if RaiseEvent HeaderPressed (column) then
// handled
return
end if
me.SortedColumn = column
_sort
End EventHandler
EventHandler Sub didDragTableColumn(tableColumn as NSTableColumnMBS)
mInsideHeaderDrag = false
mIgnoreTileEvents = false
End EventHandler
EventHandler Sub didTile()
RaiseEvent didTile
if not mIgnoreTileEvents then
if mMaintainColumnWidths then
_recalcColumnWidths()
end if
end if
End EventHandler
EventHandler Sub mouseDownInHeaderOfTableColumn(tableColumn as NSTableColumnMBS)
if mMaintainColumnWidths then
mIgnoreTileEvents = true
mInsideHeaderDrag = true
end if
End EventHandler
EventHandler Function numberOfRowsInTableView() As Integer
return mDataSource.DataSource_RowCount()
End EventHandler
EventHandler Function objectValue(column as NSTableColumnMBS, row as Integer) As Variant
dim col as Integer = ListColumnTV(column).ColumnIndex
dim myCell as ListCellTV = _cell (row, col, true)
dim t as Integer = myCell.Type
if t = ListBox.TypeCheckbox or (t = ListBox.TypeDefault and ListColumnTV(column).Type = ListBox.TypeCheckbox) then
// This is a checkbox - we return the Checkbox value, not its title text
return myCell.Checked
end
return myCell.Text
End EventHandler
EventHandler Sub setObjectValue(value as Variant, column as NSTableColumnMBS, row as Integer)
dim col as Integer = ListColumnTV(column).ColumnIndex
dim myCell as ListCellTV = _cell (row, col)
dim isCheckbox as Boolean
dim t as Integer = myCell.Type
if t = ListBox.TypeCheckbox or (t = ListBox.TypeDefault and ListColumnTV(column).Type = ListBox.TypeCheckbox) then
isCheckbox = true
end
mDataSource.DataSource_CellWillUpdate (row, col, myCell, not isCheckbox, isCheckbox)
if isCheckbox then
myCell.Checked = value.BooleanValue
elseif value isA NSAttributedStringMBS then
myCell.Text = NSAttributedStringMBS(value).text
else
myCell.Text = value.StringValue
end
mDataSource.DataSource_CellDidUpdate (row, col, myCell, not isCheckbox, isCheckbox)
RaiseEvent CellAction (row, col)
End EventHandler
EventHandler Function shouldEditTableColumn(tableColumn as NSTableColumnMBS, row as Int64) As Boolean
dim t as Integer = ListColumnTV(tableColumn).EffectiveType(row)
return t = ListBox.TypeEditable or t = ListBox.TypeCheckbox
End EventHandler
EventHandler Function shouldReorderColumn(columnIndex as Int64, newColumnIndex as Int64) As Boolean
return not RaiseEvent DenyReorderColumn (columnIndex, newColumnIndex)
End EventHandler
EventHandler Function validateDrop(info as NSDraggingInfoMBS, proposedRow as Integer, dropOperation as Integer) As Integer
// Determines whether the current row is accepted as a drop target
if mEnableDragReorder then
if dropOperation = NSTableViewMBS.NSTableViewDropAbove then
dim operationMask as Integer = info.draggingSourceOperationMask
return operationMask
end if
end if
End EventHandler
EventHandler Sub willDisplayCell(cell as NSCellMBS, tableColumn as NSTableColumnMBS, row as Int64)
#if Support_OSX_10_6
// We're using outdated NSCells instead of NSViews so that we can keep using this control in OSX 10.6.
// If you prefer to use custom NSViews (e.g. in order to add buttons, input fields, checkboxes or more labels),
// implement the ListBoxTV.view event - if there's code in that event, then this ListBoxTV.willDisplayCell won't
// be invoked, i.e. you end up with a modern NSView based TableView.
dim col as Integer = ListColumnTV(tableColumn).ColumnIndex
dim myCell as ListCellTV = _cell (row, col)
dim tfc as NSTextFieldCellMBS
dim bc as NSButtonCellMBS
if cell isA NSButtonCellMBS then
bc = NSButtonCellMBS(cell)
else
tfc = NSTextFieldCellMBS(cell)
end if
// Preset font
if mTextFont <> "" and mTextFont <> "System" then
cell.font = NSFontMBS.fontWithName (mTextFont, mTextSize)
elseif mTextSize > 0 then
cell.font = NSFontMBS.systemFontOfSize (mTextSize)
end if
if not RaiseEvent WillDisplayCell (row, col, myCell, cell, tableColumn) then
// Button title
if bc <> nil then
bc.title = myCell.text
end if
// Cell text color
if tfc <> nil then
if myCell.TextColor <> &c00000000 then
dim xc as Color = myCell.TextColor
dim c as NSColorMBS = NSColorMBS.colorWithCalibratedRGB (xc.Red/255, xc.Green/255, xc.Blue/255, 1-xc.Alpha/255)
tfc.textColor = c
else
tfc.textColor = nil
end if
end if
// Cell background color
if myCell.BackgroundColor <> &cFFFFFFFF then
dim xc as Color = myCell.BackgroundColor
dim c as NSColorMBS = NSColorMBS.colorWithCalibratedRGB (xc.Red/255, xc.Green/255, xc.Blue/255, 1-xc.Alpha/255)
if bc <> nil then
bc.backgroundColor = c
else
tfc.backgroundColor = c
#if false ' we handle this in ListDrawCellHandler.drawWithFrame so that it also works with indented text
tfc.drawsBackground = true
#endif
end if
elseif bc <> nil then
bc.backgroundColor = nil
else
tfc.backgroundColor = nil
tfc.drawsBackground = false
end if
// Cell text alignment
dim align as Integer
if myCell.alignment <> ListBox.AlignDefault then
align = myCell.alignment
else
align = ListColumnTV(tableColumn).Alignment
end if
select case align
case ListBox.AlignDefault
align = NSTextMBS.NSNaturalTextAlignment
case ListBox.AlignLeft
align = NSTextMBS.NSLeftTextAlignment
case ListBox.AlignRight
align = NSTextMBS.NSRightTextAlignment
case ListBox.AlignCenter
align = NSTextMBS.NSCenterTextAlignment
case ListBox.AlignDecimal
align = NSTextMBS.NSJustifiedTextAlignment
end select
cell.alignment = align
// Cell text indentation and background drawing (handled by ListDrawCellHandler.drawWithFrame)
if tfc <> nil then
if tfc isA ListBoxTV_Support.ListDrawCellHandler then
ListBoxTV_Support.ListDrawCellHandler(tfc).cell = myCell
end if
else
' unfortunately, we cannot indent checkbox cells
end if
end if
#endif
End EventHandler
EventHandler Function writeRowsWithIndexes(rowIndexes as NSIndexSetMBS, pboard as NSPasteboardMBS) As Boolean
dim didAdd as Boolean
call pboard.clearContents
if mEnableDrag then
me.SelectRows rowIndexes.Values ' makes sure the dragged rows are selected because the DragRow event expects that
dim drag as new DragItemTV (pboard)
dim operationMask as Integer = NSDraggingInfoMBS.NSDragOperationEvery // Xojo uses NSDragOperationEvery, Real Studio used NSDragOperationAll_Obsolete
dim locally as Boolean = false
if RaiseEvent DragRow (drag, rowIndexes.firstIndex, operationMask, locally) then
drag.FinishAddedItems
mTableView.setDraggingSourceOperationMask (operationMask, locally)
didAdd = true
end if
end if
if mEnableDragReorder then
// Put the moved rows into a MemoryBlock and pass that as a private data item in the pasteboard
dim rows() as Integer = rowIndexes.Values()
dim mb as new MemoryBlock (4 * (rows.Ubound+1))
for i as Integer = 0 to rows.Ubound
mb.Int32Value (4*i) = rows(i)
next
pboard.dataForType (DragReorderPBType) = mb
didAdd = true
end if
return didAdd
End EventHandler
Sub AcceptFileDrop(type As String)
mTableView.registerForDraggedTypes Array (NSPasteboardMBS.NSFilenamesPboardType, "public.file-url")
End Sub
Sub AcceptMacDataDrop(type As String)
me.AcceptRawDataDrop (type)
End Sub
Sub AcceptPictureDrop()
break ' missing (needs methods in DragItemTV, too)
End Sub
Sub AcceptRawDataDrop(type As String)
mTableView.registerForDraggedTypes Array (ListBoxTV_Support.convertOSType(type))
End Sub
Sub AcceptTextDrop()
mTableView.registerForDraggedTypes Array (NSPasteboardMBS.NSStringPboardType, NSPasteboardMBS.NSPasteboardTypeString)
End Sub
Sub AddRow(items() as String)
addItems items
End Sub
Sub AddRow(ParamArray items as String)
addItems items
End Sub
Function Cell(row as Integer, column as Integer) As String
return _cell(row,column).Text
End Function
Sub Cell(row as Integer, column as Integer, assigns v as String)
_cell(row,column).Text = v
_needsReload()
End Sub
Function CellAlignment(row as Integer, column as Integer) As Integer
dim cell as ListCellTV = _cell(row, column)
return cell.Alignment
End Function
Sub CellAlignment(row as Integer, column as Integer, assigns v as Integer)
dim cell as ListCellTV = _cell(row, column)
if cell.Alignment <> v then
cell.Alignment = v
_needsReload()
end if
End Sub
Function CellAlignmentOffset(row as Integer, column as Integer) As Integer
dim cell as ListCellTV = _cell(row, column)
return cell.Indentation
End Function
Sub CellAlignmentOffset(row as Integer, column as Integer, assigns v as Integer)
dim cell as ListCellTV = _cell(row, column)
if cell.Indentation <> v then
cell.Indentation = v
_needsReload()
end if
End Sub
Function CellBold(row as Integer, column as Integer) As Boolean
return _cell(row, column).Bold
End Function
Sub CellBold(row as Integer, column as Integer, assigns v as Boolean)
if _cell(row, column).Bold <> v then
_cell(row, column).Bold = v
_needsReload()
end if
End Sub
Function CellCheck(row as Integer, column as Integer) As Boolean
return _cell(row, column).Checked
End Function
Sub CellCheck(row as Integer, column as Integer, assigns v as Boolean)
if _cell(row, column).Checked <> v then
_cell(row, column).Checked = v
_needsReload()
end if
End Sub
Function CellHelpTag(row as Integer, column as Integer) As String
return _cell(row, column).ToolTip
End Function
Sub CellHelpTag(row as Integer, column as Integer, assigns v as String)
_cell(row, column).ToolTip = v
End Sub
Function CellItalic(row as Integer, column as Integer) As Boolean
return _cell(row, column).Italic
End Function
Sub CellItalic(row as Integer, column as Integer, assigns v as Boolean)
if _cell(row, column).Italic <> v then
_cell(row, column).Italic = v
_needsReload()
end if
End Sub
Function CellStyle(row as Integer, column as Integer) As ListCellTV
return _cell(row,column)
End Function
Function CellTag(row as Integer, column as Integer) As Variant
return _cell(row,column).tag
End Function
Sub CellTag(row as Integer, column as Integer, assigns v as Variant)
_cell(row,column).tag = v
End Sub
Function CellType(row as Integer, column as Integer) As Integer
dim cell as ListCellTV = _cell(row, column)
return cell.Type
End Function
Sub CellType(row as Integer, column as Integer, assigns v as Integer)
dim cell as ListCellTV = _cell(row, column)
if cell.Type <> v then
cell.Type = v
_needsReload()
end if
End Sub
Function Column(col as Integer) As ListColumnTV
return mCols(col)
End Function
Function ColumnAlignment(column as Integer) As Integer
return mCols(column).Alignment
End Function
Sub ColumnAlignment(column as Integer, assigns v as Integer)
mCols(column).Alignment = v
End Sub
Function ColumnAlignmentOffset(column as Integer) As Integer
return mCols(column).AlignmentOffset
End Function
Sub ColumnAlignmentOffset(column as Integer, assigns v as Integer)
mCols(column).AlignmentOffset = v
End Sub
Function ColumnFromXY(x as Integer, y as Integer) As Integer
dim loc0 as new NSPointMBS (x, y)
dim loc as NSPointMBS = mTableView.convertPointFromView (loc0, me.ScrollView)
return mTableView.columnAtPoint (loc)
End Function
Function ColumnSortDirection(column as Integer) As Integer
return mCols(column).SortDirection
End Function
Sub ColumnSortDirection(column as Integer, assigns dir as Integer)
mCols(column).SortDirection = dir
End Sub
Function ColumnType(column as Integer) As Integer
return mCols(column).Type
End Function
Sub ColumnType(column as Integer, assigns v as Integer)
mCols(column).Type = v
End Sub
Sub Constructor()
// We create a weak ref to ourselves so that we can pass that to our chiild classes instead of them creating more WeakRefs (this is a performance optimization)
mSelfRef = new WeakRef (me)
// Our separate class for handling listbox content (can be replaced by user)
mDataSource = new ListBoxTV_Support.ListBoxTVStaticDataSource (mSelfRef)
// Set up some local properties for cleaner access to some tableview properties
mTableView = me.View
mHeaderView = mTableView.headerView
// Context Menu preparation for Cells
mContextMenu = new ListBoxTV_Support.ListBoxTVContextMenu (mSelfRef)
// Context Menu preparation for the Header, see http://stackoverflow.com/a/3850215/43615
mTableView.headerView.menu = mContextMenu
// Let's preset the columns to automatic resizing - can be overwritten by code in Open() event or later, or disabled by setting ColumnWidths to a non-empty string.
mDefaultColumnAutoresizingStyle = NSTableViewMBS.NSTableViewUniformColumnAutoresizingStyle
mTableView.columnAutoresizingStyle = mDefaultColumnAutoresizingStyle
// We cache the selection for performance reasons (not sure if that's necessary, though)
mSelectionCache = NSIndexSetMBS.indexSet()
super.Constructor
End Sub
Sub DeleteAllRows()
mDataSource.DataSource_DeleteAllRows
me.ScrollPosition = 0
mLastAddedIndex = -1
me.Reload() ' needs to reload without delay, or rowCount won't be inquired before a redraw may occur
End Sub
Sub DeselectAll()
mTableView.deselectAll
End Sub
Function Expanded(row as Integer) As Boolean
break ' this is not supported here - use the code from "ListBox TableView (Hierarchical).rbp" instead
End Function
Sub Expanded(row as Integer, assigns exp as Boolean)
break ' this is not supported here - use the code from "ListBox TableView (Hierarchical).rbp" instead
End Sub
Function HeaderHeight() As Integer
return mTableView.headerView.frame.Height
End Function
Function Heading(col as Integer) As String
return mCols(col).headerCell.stringValue
End Function
Sub Heading(col as Integer, assigns txt as String)
mCols(col).headerCell.stringValue = txt
End Sub
Sub InvalidateCell(row as Integer, column as Integer)
// We're lazy and simply reload the entire view's cells.
// Ideally, we're determine the rect of the row/col and then call "setNeedsDisplayInRect:" instead.
_needsReload()
End Sub
Function LastIndex() As Integer
return mLastAddedIndex
End Function
Function List(row as Integer) As String
return me.Cell (row, 0)
End Function
Sub List(row as Integer, assigns v as String)
me.Cell (row, 0) = v
End Sub
Sub PressHeader(col as Integer)
// This method, contrary to just setting SortedColumn and calling Sort, should also depress the header, whereas SortedColumn should not. Doesn't work right yet, though
me.SortedColumn = col
me.Sort
End Sub
Sub RecalculateColumnWidths()
// Call this after a column or the entire control got resized and you want to keep the "*" or "%" column widths re-applied
_recalcColumnWidths()
End Sub
Sub Reload()
_reloadNow(nil)
End Sub
Function RowFromXY(x as Integer, y as Integer) As Integer
dim loc0 as new NSPointMBS (x, y)
dim loc as NSPointMBS = mTableView.convertPointFromView (loc0, me.ScrollView)
return mTableView.rowAtPoint (loc)
End Function
Function RowHeight() As Integer
return Round (mTableView.rowHeight)
End Function
Function RowPicture(row as Integer) As Picture
return _cell(row,0).picture
End Function
Sub RowPicture(row as Integer, assigns pic as Picture)
_cell(row,0).picture = pic
End Sub
Function RowTag(row as Integer) As Variant
return mDataSource.DataSource_RowTag(row)
End Function
Sub RowTag(row as Integer, assigns tag as Variant)
mDataSource.DataSource_RowTag(row) = tag
End Sub
Function SelCount() As Integer
return mSelectionCache.count
End Function
Sub SelectRows(rows() as Integer)
dim set as new NSMutableIndexSetMBS
for each row as Integer in rows
set.addIndex row
next
mSelectionCache = set
mTableView.selectRowIndexes mSelectionCache, false
End Sub
Function Selected(row as Integer) As Boolean
return mSelectionCache.containsIndex (row)
End Function
Sub Selected(row as Integer, assigns sel as Boolean)
dim isSelected as Boolean = mSelectionCache.containsIndex (row)
if isSelected <> sel then
mSelectionCache = mSelectionCache.mutableCopy
if sel then
NSMutableIndexSetMBS(mSelectionCache).addIndex row
else
NSMutableIndexSetMBS(mSelectionCache).removeIndex row
end if
mTableView.selectRowIndexes mSelectionCache, false
end if
End Sub
Function SelectedRows() As Integer()
return mSelectionCache.Values
End Function
Sub Sort()
_sort
End Sub
Function TableView() As NSTableViewMBS
return mTableView
End Function
Sub UpdateColumnWidthExpressions()
// Takes the current column widths and adjusts the ListColumnTV.WidthExpression values accordingly
_suppressReload = true
dim colSpacing as Integer = mTableView.intercellSpacing.Width // extra space that every visible column occupies
// Determine total width first
dim totalWidth as Integer
for col as Integer = 0 to mCols.Ubound
dim c as ListColumnTV = mCols(col)
dim w as Integer = Round (c.width)
if w > 0 then w = w + colSpacing
totalWidth = totalWidth + w
next
// Now update the width expressions (absolute and percentage)
dim remainWidth as Integer = totalWidth
dim asteriskValues() as Double
dim lowestAsteriskWidth as Integer = totalWidth
for col as Integer = 0 to mCols.Ubound
dim c as ListColumnTV = mCols(col)
dim w as Integer = Round (c.width)
dim expr as String = mCols(col).WidthExpression
dim v as Double
dim t as columnWidthTypes = determineColumnWidthType (columnWidthCalcTypes.actual, expr, v)
if t = columnWidthTypes.absolute or (t = columnWidthTypes.remain and w = 0) then
c.WidthExpression = Str(w,"-#")
asteriskValues.Append 0
if w > 0 then w = w + colSpacing
remainWidth = remainWidth - w
elseif t = columnWidthTypes.percentage then
c.WidthExpression = ListBoxTV_Support.trimPeriod (Str (w / totalWidth * 100,"-#.#####")) + "%"
asteriskValues.Append 0
if w > 0 then w = w + colSpacing
remainWidth = remainWidth - w
else
asteriskValues.Append w
remainWidth = remainWidth - colSpacing
if w < lowestAsteriskWidth then lowestAsteriskWidth = w
end
next
// Finally, update the asterisk width expressions
dim scale as Double = remainWidth / lowestAsteriskWidth // so that we don't have any asterisk values below 1
for col as Integer = 0 to mCols.Ubound
dim w as Integer = asteriskValues(col)
if w <> 0 then
dim c as ListColumnTV = mCols(col)
c.WidthExpression = ListBoxTV_Support.trimPeriod (Str (Max (1, w / remainWidth * scale),"-#.########")) + "*"
end if
next
finally
_suppressReload = false
End Sub
Function _cell(row as Integer, column as Integer, ignoreCache as Boolean = false) As ListCellTV
if not ignoreCache then
if mPreviousCell <> nil and mPreviousCell._internalUse.Left = row and mPreviousCell._internalUse.Right = column then
// Usually, we get three calls for the same cell in sequence - 1st from objectValue, 2nd from dataCellForTableColumn, 3rd from willDisplayCell
// We cache the cell here for performance reasons
return mPreviousCell
end if
end if
dim cell as ListCellTV = mDataSource.DataSource_Cell (row, column)
if cell = nil then
// create an empty one
cell = new ListCellTV ()
end if
cell._internalUse = row : column
mPreviousCell = cell
return cell
End Function
Function _cellBackgroundPaint(g As Graphics, row As Integer, column As Integer, textFrame as NSRectMBS, controlView as NSViewMBS) As Boolean
return RaiseEvent CellBackgroundPaint (g, row, column, textFrame, controlView)
End Function
Function _cellTextPaint(g As Graphics, row As Integer, column As Integer, x as Integer, y as Integer, textFrame as NSRectMBS, controlView as NSViewMBS) As Boolean
return RaiseEvent CellTextPaint (g, row, column, x, y, textFrame, controlView)
End Function
Function _clickedColumn() As Integer
return mTableView.clickedColumn
End Function
Function _clickedRow() As Integer
return mTableView.clickedRow
End Function
Function _compareRows(c1 as ListCellTV, c2 as ListCellTV, ByRef result as Integer) As Boolean
return RaiseEvent CompareRows (c1, c2, c1._internalUse.Left, c2._internalUse.Left, c1._internalUse.Right, result)
End Function
Function _constructContextualMenu(base as MenuItem, x as Integer, y as Integer, row as Integer, column as Integer, menu as NSMenuMBS) As Boolean
dim res as Boolean
mSelectionCache = mTableView.selectedRowIndexes()
if row < 0 then
// Header click
res = RaiseEvent ConstructContextualMenuForHeader (base, x, y, column, menu)
else
// Cell click
res = RaiseEvent ConstructContextualMenu (base, x, y, row, column, menu)
end if
return res
End Function
Sub _contextualMenuAction(hitItem as MenuItem, row as Integer, column as Integer)
call RaiseEvent ContextualMenuAction (hitItem, row, column)
End Sub
Private Function _hasFocus() As Boolean
return me.Window.Focus = me
End Function
Sub _needsReload(needsRecalcColumnWidths as Boolean = false, enableXojoColumnWidths as Boolean = false)
if _suppressReload then
return
end if
if needsRecalcColumnWidths then
// A column's WidthActual or WidthExpression was set
mColumnWidthsDirty = true
end if
if enableXojoColumnWidths then
// This means a WidthExpression (or ColumnWidths) property was set. This means the user
// may want to use the dynamic width modifiers ("%" and "*") from Xojo instead of the default
// NSTableView's columnAutoresizingStyle modes.
mHasDynamicColumnWidths = true
mTableView.columnAutoresizingStyle = NSTableViewMBS.NSTableViewLastColumnOnlyAutoresizingStyle
end if
if mReloadTimer = nil then
mReloadTimer = new Timer
AddHandler mReloadTimer.Action, AddressOf _reloadNow
mReloadTimer.Period = 0
end if
mReloadTimer.Mode = Timer.ModeSingle
mReloadTimer.Reset
End Sub
Private Sub _recalcColumnWidths()
#pragma DisableBackgroundTasks
mColumnWidthsDirty = false
mTableView.columnAutoresizingStyle = NSTableViewMBS.NSTableViewLastColumnOnlyAutoresizingStyle
dim totalWidth as Integer = me.ScrollView.documentVisibleRect.Width
dim remainingWidth as Integer = totalWidth
dim remainingMinWidth as Integer = totalWidth
dim remainingMaxWidth as Integer = totalWidth
dim asteriskCount, asteriskCountMin, asteriskCountMax as Double, asteriskColumnCount as Integer
dim actualWidth(), minWidth(), maxWidth() as Integer
dim colSpacing as Integer = mTableView.intercellSpacing.Width // extra space that every visible column occupies
// first pass - determine the space occupied by non-asterisk columns
for col as Integer = 0 to mCols.Ubound
dim minW, maxW, actW as Integer, type as columnWidthTypes
type = calcColumnWidth (columnWidthCalcTypes.actual, mCols(col).WidthExpression, totalWidth, mCols.Ubound-col, colSpacing, asteriskCount, remainingWidth, actW)
call calcColumnWidth (columnWidthCalcTypes.minimum, mCols(col).MinWidthExpression, totalWidth, mCols.Ubound-col, colSpacing, asteriskCountMin, remainingMinWidth, minW)
call calcColumnWidth (columnWidthCalcTypes.maximum, mCols(col).MaxWidthExpression, totalWidth, mCols.Ubound-col, colSpacing, asteriskCountMax, remainingMaxWidth, maxW)
actualWidth.Append actW
minWidth.Append minW
maxWidth.Append maxW
if type = columnWidthTypes.remain then
asteriskColumnCount = asteriskColumnCount + 1
end
if type = columnWidthTypes.absolute and actW <= 0 and minW <= 0 then
// hide this column
if not mCols(col).Hidden then
mCols(col).Hidden = true
end if
else
// unhide this column
if mCols(col).Hidden then
mCols(col).Hidden = false
end if
end if
next
// second pass - determine the space occupied by the remaining asterisk columns
if asteriskCount > 0 then
remainingWidth = Round (Max (0, remainingWidth - asteriskColumnCount * colSpacing))
dim asteriskWidth as Double = remainingWidth / asteriskCount
dim lastAsteriskCol as Integer = -1
for col as Integer = 0 to mCols.Ubound
if remainingWidth < 0 then remainingWidth = 0
dim value as Double
dim type as columnWidthTypes = determineColumnWidthType (columnWidthCalcTypes.actual, mCols(col).WidthExpression, value)
if type = columnWidthTypes.remain then
dim columnWidth as Double = Round (value * asteriskWidth)
actualWidth(col) = columnWidth
lastAsteriskCol = col
remainingWidth = remainingWidth - columnWidth
asteriskCount = asteriskCount - value
if asteriskCount <= 0 then exit
end if
next
if lastAsteriskCol >= 0 then
actualWidth(lastAsteriskCol) = actualWidth(lastAsteriskCol) + remainingWidth
end
end if
// finally, set the actual widths in the table view
mIgnoreTileEvents = true
for col as Integer = 0 to mCols.Ubound
dim c as ListColumnTV = mCols(col)
c.minWidth = minWidth(col)
c.maxWidth = maxWidth(col)
c.width = actualWidth(col)
next
RaiseEvent DidResizeCells()
finally
mIgnoreTileEvents = false
End Sub
Private Sub _reloadNow(t as Timer)
if mReloadTimer <> nil then mReloadTimer.Mode = Timer.ModeOff
mIgnoreTileEvents = false
mInsideHeaderDrag = false
if mColumnWidthsDirty then
mColumnWidthsDirty = false
if mHasDynamicColumnWidths then
// A column's WidthExpression had been set, so we want to re-adjust the columns accordingly, once
_recalcColumnWidths()
end if
end if
mTableView.reloadData
if not mMaintainColumnWidths then
mTableView.columnAutoresizingStyle = mDefaultColumnAutoresizingStyle
end
End Sub
Function _selectedRow() As Integer
return mTableView.selectedRow
End Function
Sub _sort()
dim sorters() as NSSortDescriptorMBS = mTableView.sortDescriptors
if sorters.Ubound < 0 then return
dim firstSorter as NSSortDescriptorMBS = sorters(0)
dim col as Integer = mTableView.columnWithIdentifier(firstSorter.key)
if RaiseEvent SortColumn (col) then
// user's event code handled the sorting
return
end if
mDataSource.DataSource_SortRows sorters
mTableView.reloadData
End Sub
Private Sub addItems(items() as String)
if mDataSource isA ListBoxTV_Support.ListBoxTVStaticDataSource then
dim col0 as String
if items.Ubound >= 0 then
col0 = items(0)
end if
ListBoxTV_Support.ListBoxTVStaticDataSource(mDataSource).AddRow col0
mLastAddedIndex = mDataSource.DataSource_RowCount-1
for column as Integer = 1 to items.Ubound
_cell(mLastAddedIndex,column).text = items(column)
next
else
break // If you have assigned your own DataSource, then you cannot use AddRow() as that makes little sense
end if
_needsReload
End Sub
Private Function calcColumnWidth(calcType as columnWidthCalcTypes, expr as String, totalWidth as Integer, colsLeft as Integer, extraSpace as Integer, ByRef asterisksInOut as Double, ByRef remainWidthInOut as Integer, ByRef widthOut as Integer) As columnWidthTypes
dim space as Double
dim value as Double
dim type as columnWidthTypes = determineColumnWidthType (calcType, expr, value)
if type = columnWidthTypes.absolute then
space = Round (value)
elseif type = columnWidthTypes.percentage then
space = Round (totalWidth * value / 100)
else
asterisksInOut = asterisksInOut + Max (1, value)
end if
remainWidthInOut = remainWidthInOut - space
if space > 0 then
// if this column occupies some space, the Cell will actually add some more pixels, which we need to remove from the remaining space
remainWidthInOut = remainWidthInOut - extraSpace
if remainWidthInOut < 0 and space > -remainWidthInOut then
space = space + remainWidthInOut
remainWidthInOut = 0
end if
end if
widthOut = space
return type
End Function
Private Function determineColumnWidthType(calcType as columnWidthCalcTypes, expr as String, ByRef value as Double) As columnWidthTypes
#pragma DisableBackgroundTasks
expr = expr.Trim
if expr = "" then
if calcType = columnWidthCalcTypes.actual then
value = 1
return columnWidthTypes.remain
elseif calcType = columnWidthCalcTypes.maximum then
value = 100
return columnWidthTypes.percentage
else
value = 0
return columnWidthTypes.absolute
end if
end if
dim number as Double, pos as Integer
for pos = 1 to expr.Len
dim ch as Integer = expr.Mid(pos,1).Asc
if (ch < 48 or ch > 57) and ch <> 46 then
' not a digit nor a period (.)
exit
end if
next
number = expr.Left(pos-1).Val
expr = expr.Mid(pos).Trim
if expr = "" then
' absolute value
value = number
return columnWidthTypes.absolute
elseif expr = "%" then
' percentage
value = number
return columnWidthTypes.percentage
else
' remaining space
value = Max (1, number)
return columnWidthTypes.remain
end if
End Function
Private Function handleMouseDown(x as Integer, y as Integer, modifiers as Integer) As Boolean
if RaiseEvent MouseDown (x, y) then
return true
end
#if Target64Bit
declare function frameOfCellAtColumn_Row lib "Cocoa" selector "frameOfCellAtColumn:row:" (o as Integer, col as Integer, row as Integer) as NSRect64
#else
declare function frameOfCellAtColumn_Row lib "Cocoa" selector "frameOfCellAtColumn:row:" (o as Integer, col as Integer, row as Integer) as NSRect32
#endif
dim loc0 as new NSPointMBS (x, y)
dim loc as NSPointMBS = mTableView.convertPointFromView (loc0, me.ScrollView)
dim row as Integer = mTableView.rowAtPoint (loc)
dim col as Integer = mTableView.columnAtPoint (loc)
dim cellFrame as NSRectMBS = mTableView.frameOfCellAtColumnRow (col, row)
return RaiseEvent CellClick (row, col, loc.x - cellFrame.x, loc.y - cellFrame.y)
End Function
Private Sub setDelayedProperties()
// Handle some delayed settings (appears to be necessary with Real Studio 2012 but not with Xojo 2016)
mHadOpenEvent = true
me.ColumnCount = mDelayedColumnCount
me.AutoHideScrollBars = mDelayedHideScrollers
me.ColumnsResizable = mDelayedColumnResizing
me.RequiresSelection = mDelayedRequiresSelection
me.ScrollbarHorizontal = mDelayedHorScroller
me.ScrollbarVertical = mDelayedVerScroller
me.SelectionType = mDelayedSelectionType
me.ColumnWidths = mDelayedColumnWidths
if me.Hierarchical then
break ' this is not supported here - use the code from "ListBox OutlineView.rbp" instead
end if
End Sub
Private Sub setupFromInitialValue()
dim rows() as String = ReplaceLineEndings(me.InitialValue, EndOfLine).Split(EndOfLine)
if me.HasHeading and rows.Ubound >= 0 then
dim cols() as String = rows(0).Split(Chr(9))
for i as Integer = 0 to Min (cols.Ubound, me.ColumnCount-1)
me.Heading(i) = cols(i)
next
rows.Remove 0
end if
for each row as String in rows
dim cols() as String = row.Split(Chr(9))
me.AddRow cols(0)
for i as Integer = 1 to Min (cols.Ubound, me.ColumnCount-1)
me.Cell(mLastAddedIndex, i) = cols(i)
next
next
End Sub
Note "About"
This is a (nearly complete) replacement for Xojo's ListBox control, for Mac OS X.
It requires MBS Plugins 17.1 (March 9, 2017 or later)
Advantages over Xojo's ListBox:
• Uses Apple's native NSTableView control, with its proper appearance, hence...
• Looks better in a Mac app.
• Column resizing works better (observing minimum widths and showing a horizontal scrollbar when necessary).
• Support column reordering.
• Supports right-clicks (CMM clicks) on the headers.
• Correct handling of multiple selected rows, including right-clicks.
• Offers more customization options (e.g., you get extra Events from the NSTableView).
• ConstructContextualMenu works as it should (i.e. for right clicks and ctrl-clicks).
• Faster.
• Open Source.
Disadvantages:
• Mac-only.
• No custom drawing in cells via ...Paint events (but you can instead use NSGraphicsMBS functions).
• No support for Database Binding.
• Limited grid line options.
• A few functions where a -1 parameter designates ALL rows or columns do not work (leading to an OutOfRangeException),
such as InvalidateCell(-1,-1).
To use it, copy the entire "ListBox_NSTableView" folder into your project, then change the Super class of your ListBox controls
to ListBoxTV, and see if your project still compiles and runs.
If you're using the CellBackgroundPaint or CellTextPaint events, see if you're only using it to change the color or
font of the cells and text. See the note "Handling CellBackgroundPaint and CellTextPaint" for a possible solution.
Note "Attn sortDescriptorsDidChange"
The sortDescriptorsDidChange event is not implemented here because we handle
sorting in the tableView's didClickTableColumn event, which is called after this event.
Note "Authors and Copyright"
Initial author (Feb 2017): Thomas Tempelmann, tempelmann@gmail.com
This code is free, i.e. no contributing author may claim rights (or copyright) on it.
If you add new features, please send them back to Thomas for redistribution.
Adding a test case for the new feature would be nice, too.
Note "Handling CellBackgroundPaint and CellTextPaint"
If you implement either of these events to draw custom text or images, they won't work, because the "g as Graphics" parameter will be nil
(that's a limitation caused by Xojo Inc. because their Plugin API does not supply the needed code for making use of the Graphics class).
If you only want to have a particular background or text color, you can instead preset them like this:
myListbox.CellStyle (row, col).TextColor = ...
myListbox.CellStyle (row, col).BackgroundColor = ...
Note "Handling contextual clicks (right click; ctrl-click)"
Since the Xojo ListBox's ConstructContextualMenu event does not handle right clicks (or ctrl-clicks)
correctly with multiple selections, you may have tried to ignore the event and instead handle such
clicks in the MouseDown event by checking "IsContextualClick". You may still do that.
But if you plan to use the ConstructContextualMenu, you need to set the ListBoxTV's control's
UseContextualClickEvent property to True, e.g. right in the Window layout editor for the control,
so that ConstructContextualMenu gets called as desired.
You should do that (i.e. set UseContextualClickEvent=true and use ConstructContextualMenu)
over checking for IsContextualClick in the MouseDown event in order to have proper behavior,
especially when you allow multi-selection in the Listbox.
Note "NSView vs. NSCell based TableView cells"
By default, the TableView is in NSCell mode, which works with a limited set of predefined layout choices.
The code handling this layout is found in the ListBoxTV.willDisplayCell() event.
Alternatively, you can supply your own layout by returning a custom NSViewMBS from the ListBoxTV.view()
event. If the view() event is added, the willDisplayCell() event becomes unused automatically. So, if you
experiment with returning an NSView and are not happy with it, you need to remove the view() event
entirely again to revert to using the NSCell mode.
As a simple example, here's how to put a button into every cell. Place the following code into the view() event:
dim button as new NSButtonMBS
button.Title = "Button"
return button
To add multiple views, see the forum: https://forum.xojo.com/49354-listboxtv-mbs-plugins
Note "On-demand Cell values (custom DataSource)"
If you have a lot (thousands) of rows, the performance of Xojo's ListBox will notably decrease.
With this ListBoxTV, you can prevent this.
The solution is to not add your rows and cells beforehand, by using AddRow(), but instead just
tell the Listbox how many rows you have. The TableView class will then show an adequate scrollbar
for the entire number of rows, but will only ask you to provide the data for the rows and cells
it currently shows in the window, which will be usually only a few dozen values. If the user
scrolls the list, your code will then be asked again for only those new cells, and so on.
To accomplish that, implement the ListBoxTVDataSource interface. Either implement them in a new
class, or add them to your window or other class that you already maintain for your data.
You do not need to add code for all its functions, which all begin with "DataSource_". Most of
them you may leave empty, unless you want to support sorting, row dragging, column dragging or
editing.
Then set the listbox's DataSource property to your class that implements the ListBoxTVDataSource interface.
The minimum you have to add code to are:
• DataSource_RowCount() as Integer
Here you need to return the total number of rows you want to be able to show.
• DataSource_Cell (row as Integer, column as Integer) as ListCellTV
This returns an object of type ListCellTV, which contains the Text property for the cell's display,
as well as other properties such as Indentation, Alignment etc.
If you want to keep it simple, return this:
return new ListCellTV (row, column, "here goes the cell's text")
Now, whenever you know the listbox needs to be refreshed, i.e. it should call your DataSource_RowCount()
and DataSource_Cell() functions again, call the listbox's Reload() function.
Note "To Do"
Not working, yet:
• Hierarchical (use the code from "ListBoxTV OutlineView.rbp" instead)
• Row Insert + Delete ("ListBoxTV OutlineView.rbp" has a RemoveRow method, at least)
• Font attributes (bold, italic) for entire list defaults and for individual cells
Note "Version History"
Released Versions (oldest first)
3 - (16 Aug 2018)
• Should now work in 64 bit builds (by fixing NSRect struct usage)
4 - (18 Aug 2018)
• Fixes the vertical scrollbar gap no matter what the System Preferences "General" / "Show scroll bars" is set to.
5 - (20 Aug 2018)
• Fixes placement of the ContainerControl (in some circumstance, its original would get moved to negative offsets).
• Can now add multiple columns in one AddRow() call.
Property DefaultRowHeight As Integer
Property Hierarchical As Boolean
Property InitialValue As String
Property _suppressReload As Boolean
Property Private mCols() As ListColumnTV
Property Private mColumnWidthsDirty As Boolean
Property Private mContextMenu As ListBoxTV_Support.ListBoxTVContextMenu
Property Private mDataSource As ListBoxTVDataSource
Property Private mDefaultColumnAutoresizingStyle As Integer
Property Private mDelayedColumnCount As Integer
Property Private mDelayedColumnResizing As Boolean
Property Private mDelayedColumnWidths As String
Property Private mDelayedHideScrollers As Boolean
Property Private mDelayedHorScroller As Boolean
Property Private mDelayedRequiresSelection As Boolean
Property Private mDelayedSelectionType As Integer
Property Private mDelayedVerScroller As Boolean
Property Private mEnableDrag As Boolean
Property Private mEnableDragReorder As Boolean
Property Private mHadOpenEvent As Boolean
Property Private mHasDynamicColumnWidths As Boolean
Property Private mHeaderView As NSTableHeaderViewMBS
Property Private mIgnoreTileEvents As Boolean
Property Private mInsideHeaderDrag As Boolean
Property Private mLastAddedIndex As Integer
Property Private mMaintainColumnWidths As Boolean
Property Private mPreviousCell As ListCellTV
Property Private mReloadTimer As Timer
Property Private mSelectionCache As NSIndexSetMBS
Property Private mSelectionType As Integer
Property Private mSelfRef As WeakRef
Points to itself. This is an optimization so that we don't have to create multiple WeakRefs in each child object
Property Private mTableView As NSTableViewMBS
Property Private mTextFont As String
Property Private mTextSize As Integer
Property Private mUseContextualClickEvent As Boolean
Structure NSRect32
x as Single
y as Single
w as Single
h as Single
End Structure
Structure NSRect64
x as Double
y as Double
w as Double
h as Double
End Structure
End Class
Module ListBoxTV_Support
Protected Function convertOSType(t as String) As String
if t.Len = 4 then
// convert OSType to UTI
t = UTTypeMBS.CreatePreferredIdentifierForTag (UTTypeMBS.kUTTagClassOSType, t, UTTypeMBS.kUTTypeData)
end if
return t
End Function
Protected Function trimPeriod(s as String) As String
if s.Right(1) = "." then
return s.Left (s.Len-1)
else
return s
end if
End Function
End Module
Class ListColumnTV Inherits NSTableColumnMBS
ComputedProperty Alignment As Integer
Sub Set()
if mAlignment <> value then
mAlignment = value
owner._needsReload()
end if
End Set
Sub Get()
return mAlignment
End Get
End ComputedProperty
ComputedProperty AlignmentOffset As Integer
Sub Set()
if mAlignmentOffset <> value then
mAlignmentOffset = value
owner._needsReload()
end if
End Set
Sub Get()
return mAlignmentOffset
End Get
End ComputedProperty
ComputedProperty ColumnIndex As Integer
Sub Get()
return mColumnIndex
End Get
End ComputedProperty
ComputedProperty MaxWidthActual As Integer
Sub Set()
mMaxWidthExpr = Str(value,"#")
owner._needsReload(true)
me.maxWidth = value
End Set
Sub Get()
return Round (me.maxWidth)
End Get
End ComputedProperty
ComputedProperty MaxWidthExpression As String
Sub Set()
mMaxWidthExpr = value
owner._needsReload(true, true)
End Set
Sub Get()
return mMaxWidthExpr
End Get
End ComputedProperty
ComputedProperty MinWidthActual As Integer
Sub Set()
mMinWidthExpr = Str(value,"#")
owner._needsReload(true)
me.minWidth = value
End Set
Sub Get()
return Round (me.minWidth)
End Get
End ComputedProperty
ComputedProperty MinWidthExpression As String
Sub Set()
mMinWidthExpr = value
owner._needsReload(true, true)
End Set
Sub Get()
return mMinWidthExpr
End Get
End ComputedProperty
ComputedProperty SortDirection As Integer
Sub Set()
if mSortDirection <> value then
mSortDirection = value
owner._needsReload()
end if
End Set
Sub Get()
return mSortDirection
End Get
End ComputedProperty
ComputedProperty UserResizable As Boolean
Sub Set()
me.Resizable = value
End Set
Sub Get()
return me.Resizable
End Get
End ComputedProperty
ComputedProperty WidthActual As Integer
Sub Set()
mWidthExpr = Str(value,"#")
owner._needsReload(true)
me.width = value
End Set
Sub Get()
return Round (me.width)
End Get
End ComputedProperty
ComputedProperty WidthExpression As String
Sub Set()
mWidthExpr = value
owner._needsReload(true, true)
End Set
Sub Get()
return mWidthExpr
End Get
End ComputedProperty
Sub Constructor(ownerRef as WeakRef, colNum as Integer)
mOwner = ownerRef
mColumnIndex = colNum
static lastID as Integer
lastID = lastID + 1
dim id as String = Str(lastID,"#") ' Since columns can be reordered, id can't identify the column index, but only ColumnIndex can.
super.Constructor (id)
const NSCaseInsensitiveSearch = 1
const NSLiteralSearch = 2
const NSBackwardsSearch = 4
const NSAnchoredSearch = 8
const NSNumericSearch = 64 ' -> smart sort where numbers get ordered properly
const NSDiacriticInsensitiveSearch = 128
const NSWidthInsensitiveSearch = 256
const NSForcedOrderingSearch = 512
// Set up default sort handling, for when the ListboxTV.SortColumn and ListboxTV.CompareRows events are not used
dim opts as Integer = NSCaseInsensitiveSearch + NSDiacriticInsensitiveSearch + NSNumericSearch
// Install the primary and secondary sort descriptors
dim sorter as NSSortDescriptorMBS = NSSortDescriptorMBS.sortDescriptorWithKeyWithCompare ("", true, opts) ' this sorter is used when the CompareRows() event returns false
mSortHandler = new ListRowComparator (mOwner, me, sorter) ' this is our internal sorter that invokes CompareRows() and falls back to the above sorter
me.sortDescriptorPrototype = mSortHandler
// Set some UI options
dim cell as NSCellMBS = me.headerCell
cell.wraps = false
cell.lineBreakMode = NSParagraphStyleMBS.NSLineBreakByTruncatingTail
End Sub
Function EffectiveType(row as Integer) As Integer
dim myCell as ListCellTV = owner._cell(row, ColumnIndex)
dim t as Integer = myCell.Type
if t = ListBox.TypeDefault then
return me.Type
else
return t
end
End Function
Sub SetFontAndSize(fontName as String, size as Double = 0)
if fontName = "" or fontName = "System" or fontName = "SmallSystem" then
me.headerCell.font = NSFontMBS.systemFontOfSize (size)
else
me.headerCell.font = NSFontMBS.fontWithName (fontName, size)
end if
End Sub
Sub _updateOwnIndex()
mColumnIndex = me.tableView.columnWithIdentifier (me.identifier)
End Sub
Private Function owner() As ListBoxTV
return ListBoxTV (mOwner.Value)
End Function
Property Tag As Variant
You may set this to anything you like - if the user drags the column to another position, this Tag will move along.
Property Type As Integer
Property Private mAlignment As Integer
Property Private mAlignmentOffset As Integer
Property Private mColumnIndex As Integer
Property Private mMaxWidthExpr As String
Property Private mMinWidthExpr As String
Property Private mOwner As WeakRef
ListBoxTV
Property Private mSortDirection As Integer
Property Private mSortHandler As NSSortDescriptorMBS
Property Private mWidthExpr As String
End Class
Class ListCellTV
ComputedProperty Picture As Picture
Sub Set()
mPicture = value
me.nsImage = new NSImageMBS (value, value.Mask(false))
End Set
Sub Get()
return mPicture
End Get
End ComputedProperty
Sub Constructor(text as String = "", checked as Boolean = false)
me.Text = text
me.Checked = checked
End Sub
Property Alignment As Integer
Use ListBox.Align... constants here
Property BackgroundColor As Color = &cFFFFFFFF
Property Bold As Boolean
Property Checked As Boolean
Property Indentation As Integer
Property Italic As Boolean
Property Tag As Variant
Property Text As String
Property TextColor As Color = &c00000000
Property ToolTip As String
Property Type As Integer
Use ListBox.Type... constants here
Property _internalUse As Pair
This will be modified internally during Sort and Draw operations
Property Private mPicture As Picture
Property nsImage As NSImageMBS
End Class
Class DragItemTV
Sub AddItem(x as Integer, y as Integer, w as Integer, h as Integer)
mItems.Append new NSPasteboardItemMBS
mCurrentItemIdx = mItems.Ubound
End Sub
Private Function BestType(paramarray t() as String) As String
return mItems(mCurrentItemIdx).availableTypeFromArray(t)
End Function
Sub Constructor(pb as NSPasteboardMBS)
mPboard = pb
mItems = pb.pasteboardItems
if mItems.Ubound < 0 then
AddItem(0,0,0,0)
end if
Reset()
End Sub
Sub FinishAddedItems()
call mPboard.SetPasteboardItems mItems
End Sub
Function FolderItem() As FolderItem
dim f as FolderItem
dim item as NSPasteboardItemMBS = mItems(mCurrentItemIdx)
dim s as String = item.stringForType(NSPasteboardMBS.NSFilenamesPboardType).DefineEncoding(Encodings.UTF8)
if s <> "" then
f = PathToFolderItemMBS (s)
else
s = item.stringForType("public.file-url").DefineEncoding(Encodings.UTF8)
f = new FolderItem (s, FolderItem.PathTypeURL)
end if
return f
End Function
Sub FolderItem(assigns f as FolderItem)
mItems(mCurrentItemIdx).stringForType("public.file-url") = f.URLPath.ConvertEncoding(Encodings.UTF8)
End Sub
Function FolderItemAvailable() As Boolean
return HasType(NSPasteboardMBS.NSFilenamesPboardType, "public.file-url")
End Function
Function HasType(paramarray t() as String) As Boolean
return mItems(mCurrentItemIdx).availableTypeFromArray(t) <> ""
End Function
Function NextItem() As Boolean
dim res as Boolean = true
mCurrentItemIdx = mCurrentItemIdx + 1
if mCurrentItemIdx > mItems.Ubound then
mCurrentItemIdx = 0
res = false
end
mTypes = mItems(mCurrentItemIdx).types
return res
End Function
Function Pboard() As NSPasteboardMBS
return mPboard
End Function
Function RawData(type as String) As String
type = BestType (ListBoxTV_Support.convertOSType(type))
dim s as String = mItems(mCurrentItemIdx).stringForType(type)
return s
End Function
Sub RawData(type as String, assigns s as String)
mItems(mCurrentItemIdx).stringForType(ListBoxTV_Support.convertOSType(type)) = s
End Sub
Function RawDataAvailable(type as String) As Boolean
return HasType (ListBoxTV_Support.convertOSType(type))
End Function
Private Sub Reset()
mCurrentItemIdx = -1
call NextItem
End Sub
Function Text() As String
dim t as String = BestType (NSPasteboardMBS.NSPasteboardTypeString, NSPasteboardMBS.NSStringPboardType)
dim s as String = mItems(mCurrentItemIdx).stringForType(t).DefineEncoding(Encodings.UTF8)
return s
End Function
Sub Text(assigns s as String)
mItems(mCurrentItemIdx).stringForType(NSPasteboardMBS.NSPasteboardTypeString) = s.ConvertEncoding(Encodings.UTF8)
End Sub
Function TextAvailable() As Boolean
return HasType(NSPasteboardMBS.NSPasteboardTypeString, NSPasteboardMBS.NSStringPboardType)
End Function
Property Private mCurrentItemIdx As Integer
Property Private mItems() As NSPasteboardItemMBS
Property Private mPboard As NSPasteboardMBS
Property Private mTypes() As String
End Class
Interface ListBoxTVDataSource
Function DataSource_Cell(row as Integer, column as Integer) As ListCellTV
Sub DataSource_CellDidUpdate(row as Integer, column as Integer, cell as ListCellTV, updatesText as Boolean, updatesChecked as Boolean)
Sub DataSource_CellWillUpdate(row as Integer, column as Integer, cell as ListCellTV, updatesText as Boolean, updatesChecked as Boolean)
Sub DataSource_DeleteAllRows()
Sub DataSource_MoveColumn(fromIdx as Integer, toIdx as Integer)
Sub DataSource_MoveRows(fromIdxs() as Integer, toAboveIdx as Integer)
Function DataSource_RowCount() As Integer
Function DataSource_RowTag(row as Integer) As Variant
Sub DataSource_RowTag(row as Integer, assigns tag as Variant)
Sub DataSource_SetColumnCount(colCount as Integer)
Sub DataSource_SortRows(sorters() as NSSortDescriptorMBS)
End Interface
Class ListRowTV Inherits KeyValueCodingMBS
EventHandler Function Description() As String
// Lets return all cells' values, TAB-separated
dim res() as String
for each c as ListCellTV in cells
dim s as String = c.text
if s.Len > 20 then
s = s.Left(20)+"…"
end
res.Append s
next
return Join(res, Chr(9))
End EventHandler
EventHandler Function valueForKey(key as string) As Variant
// This is only called when performing a sort using sort descriptors
// (see ListBoxTVDataSource.sortDescriptorsDidChange)
dim col as Integer = owner.TableView.columnWithIdentifier(key)
dim cell as ListCellTV = cells(col)
cell._internalUse = me.row : col
return cell
End EventHandler
Sub Constructor(ownerRef as WeakRef, columnCount as Integer, row as Integer)
mOwner = ownerRef
me.row = row
redim me.cells(columnCount-1)
super.Constructor
End Sub
Sub MoveColumn(fromIdx as Integer, toIdx as Integer)
dim c as ListCellTV = cells(fromIdx)
cells.Remove fromIdx
cells.Insert toIdx, c
End Sub
Private Function owner() As ListBoxTV
return ListBoxTV (mOwner.Value)
End Function
Property cells() As ListCellTV
Property Private mOwner As WeakRef
ListBoxTV
Property row As Integer
Property tag As Variant
End Class
Class ListRowComparator Inherits NSSortDescriptorMBS
EventHandler Function Comparator(obj1 as variant, obj2 as variant) As Integer
dim c1 as ListCellTV = obj1
dim c2 as ListCellTV = obj2
#if DebugBuild
if c1._internalUse.Right <> column.ColumnIndex or c1._internalUse.Right <> c2._internalUse.Right then raise new RuntimeException ' is this happens, we forgot up update the Column somewhere
#endif
dim res as integer
if owner._compareRows (c1, c2, res) then
return res
end
declare function compareObjectTo lib "Cocoa" selector "compareObject:toObject:" (h as Integer, o1 as CFStringRef, o2 as CFStringRef) as Integer
try
res = compareObjectTo (mSorter.Handle, c1.Text, c2.Text)
catch exc as ObjCException
break
end try
return res
End EventHandler
Sub Constructor(ownerRef as WeakRef, column as ListColumnTV, sorter as NSSortDescriptorMBS)
super.Constructor (column.identifier, true)
mOwner = ownerRef
mColumn = new WeakRef(column)
mSorter = sorter
End Sub
Function column() As ListColumnTV
return ListColumnTV (mColumn.Value)
End Function
Private Function owner() As ListBoxTV
return ListBoxTV (mOwner.Value)
End Function
Property Private mColumn As WeakRef
ListColumnTV
Property Private mOwner As WeakRef
ListBoxTV
Property Private mSorter As NSSortDescriptorMBS
End Class
Class ListBoxTVStaticDataSource
Sub AddRow(txt as String)
dim row as new ListRowTV (mOwner, mColumnCount, mRows.Ubound+1)
mRows.Append row
dim cell as ListCellTV = me.DataSource_Cell (mRows.Ubound, 0) ' -> allocates the cell in the row object
cell.Text = txt
End Sub
Sub Constructor(ownerRef as WeakRef)
mOwner = ownerRef
End Sub
Function DataSource_Cell(row as Integer, column as Integer) As ListCellTV
dim cells() as ListCellTV = mRows(row).cells
dim res as ListCellTV = cells(column)
if res is nil then
// This cell has not been accessed before - create it now
res = new ListCellTV ()
cells(column) = res
end if
return res
End Function
Sub DataSource_CellDidUpdate(row as Integer, column as Integer, cell as ListCellTV, updatesText as Boolean, updatesChecked as Boolean)
// Nothing to do here - it exists for use with custom implementations of the ListBoxTVDataSource interface
End Sub
Sub DataSource_CellWillUpdate(row as Integer, column as Integer, cell as ListCellTV, updatesText as Boolean, updatesChecked as Boolean)
// Nothing to do here - it exists for use with custom implementations of the ListBoxTVDataSource interface
End Sub
Sub DataSource_DeleteAllRows()
redim mRows(-1)
End Sub
Sub DataSource_MoveColumn(fromIdx as Integer, toIdx as Integer)
for each row as ListRowTV in mRows
row.MoveColumn fromIdx, toIdx
next
End Sub
Sub DataSource_MoveRows(fromIdxs() as Integer, toAboveIdx as Integer)
dim oldIndexOffset, newIndexOffset, firstAffected, lastAffected as Integer
fromIdxs.Sort
firstAffected = toAboveIdx
lastAffected = toAboveIdx
for each oldIndex as Integer in fromIdxs
dim fromIdx, toIdx as Integer
if oldIndex < toAboveIdx then
if oldIndex < firstAffected then firstAffected = oldIndex
fromIdx = oldIndex + oldIndexOffset
toIdx = toAboveIdx - 1
oldIndexOffset = oldIndexOffset - 1
else
if oldIndex > lastAffected then lastAffected = oldIndex
fromIdx = oldIndex
toIdx = toAboveIdx + newIndexOffset
newIndexOffset = newIndexOffset + 1
end
dim row as ListRowTV = mRows(fromIdx)
mRows.Remove fromIdx
mRows.Insert toIdx, row
next
if lastAffected > mRows.Ubound then lastAffected = mRows.Ubound
for row as Integer = firstAffected to lastAffected
mRows(row).row = row
next
owner._needsReload
owner.DeselectAll
End Sub
Function DataSource_RowCount() As Integer
return mRows.Ubound+1
End Function
Function DataSource_RowTag(row as Integer) As Variant
return mRows(row).tag
End Function
Sub DataSource_RowTag(row as Integer, assigns tag as Variant)
mRows(row).tag = tag
End Sub
Sub DataSource_SetColumnCount(colCount as Integer)
mColumnCount = colCount
dim newUbound as Integer = colCount-1
for each row as ListRowTV in mRows
dim cells() as ListCellTV = row.cells
redim cells(newUbound)
next
End Sub
Sub DataSource_SortRows(sorters() as NSSortDescriptorMBS)
dim newRows() as KeyValueCodingMBS = KeyValueCodingMBS.sortedArrayUsingDescriptors (mRows, sorters)
for i as Integer = 0 to newRows.Ubound
dim row as ListRowTV = ListRowTV(newRows(i))
row.row = i
mRows(i) = row
next
End Sub
Private Function owner() As ListBoxTV
return ListBoxTV (mOwner.Value)
End Function
Property Private mColumnCount As Integer
Property Private mOwner As WeakRef
ListBoxTV
Property Private mRows() As ListRowTV
End Class
Class ListDrawCellHandler Inherits CustomNSTextFieldCellMBS
Const ImageInset = 3
EventHandler Function drawWithFrame(cellFrame as NSRectMBS, controlView as NSViewMBS) As boolean
dim textFrame as NSRectMBS = titleRectForBounds (cellFrame)
dim lb as ListBoxTV = ListBoxTV(mOwner.Value)
lb._suppressReload = true
dim row as Integer = me.cell._internalUse.Left
dim col as Integer = me.cell._internalUse.Right
if not lb._cellBackgroundPaint (nil, row, col, textFrame, controlView) then
// draw background for entire cell, even if the text is indented
if me.backgroundColor <> nil then
dim g as new NSGraphicsMBS
g.setFillColor me.backgroundColor
g.fillRect cellFrame
end if
end if
if cell.nsImage <> nil then
#if Target64Bit
declare sub drawInRect lib "Cocoa" selector "drawInRect:fromRect:operation:fraction:respectFlipped:hints:" ( _
h as Integer, dst as NSRect64, src as NSRect64, operation as Integer, fraction as Double, respectFlipped as Boolean, hints as Ptr)
dim dr, zeroRect as NSRect64
#else
declare sub drawInRect lib "Cocoa" selector "drawInRect:fromRect:operation:fraction:respectFlipped:hints:" ( _
h as Integer, dst as NSRect32, src as NSRect32, operation as Integer, fraction as Single, respectFlipped as Boolean, hints as Ptr)
dim dr, zeroRect as NSRect32
#endif
dim img as NSImageMBS = cell.nsImage
dr.w = img.width
dr.h = img.height
dr.x = cellFrame.x + ImageInset
dr.y = cellFrame.y + (cellFrame.Height - dr.h) \ 2
drawInRect (img.Handle, dr, zeroRect, NSGraphicsMBS.NSCompositeSourceOver, 1, controlView.isFlipped, nil)
end if
if not lb._cellTextPaint (nil, row, col, 0, 0, textFrame, controlView) then
superDrawWithFrame textFrame, controlView
end if
lb._suppressReload = false
return true
End EventHandler
EventHandler Function titleRectForBounds(rect as NSRectMBS) As NSRectMBS
// Let's indent the text (based on the cell's or column's AlignmentOffset, set in ListBoxTV.dataCellForTableColumn)
dim ofs as Integer = me.cell.Indentation
if me.cell.nsImage <> nil then
ofs = ofs + me.cell.nsImage.width + (2 * ImageInset)
end if
rect.X = rect.X + ofs
rect.Width = rect.Width - ofs
return rect
End EventHandler
Sub Constructor(owner as WeakRef)
mOwner = owner
super.Constructor
End Sub
Note "About"
This handles custom drawing for cells.
Note: This only works for "normal" cells, not for Checkbox cells - they would need a different NSCell subclass implementation from MBS, which isn't available (yet).
Property cell As ListCellTV
Property Private mOwner As WeakRef
Structure NSRect32
x as Single
y as Single
w as Single
h as Single
End Structure
Structure NSRect64
x as Double
y as Double
w as Double
h as Double
End Structure
End Class
Class ListBoxTVContextMenuItem Inherits NSMenuItemMBS
EventHandler Sub Action()
owner.MenuItemAction (me)
End EventHandler
Sub Constructor(menu as ListBoxTVContextMenu, item as MenuItem)
super.Constructor (item.Text, "")
mOwner = new WeakRef (menu)
me.Item = item
End Sub
Private Function owner() As ListBoxTVContextMenu
return ListBoxTVContextMenu (mOwner.Value)
End Function
Property Item As MenuItem
Property Private mOwner As WeakRef
ListBoxTVContextMenu
End Class
Class ListBoxTVContextMenu Inherits NSMenuMBS
EventHandler Sub EnableMenuItems()
me.Clear
dim row as Integer = owner._clickedRow
dim col as Integer = owner._clickedColumn
if row < 0 then
// Click in Header
// clickedColumn is always -1 in this case, so we need to calculate it manually
dim ev as NSEventMBS = NSApplicationMBS.sharedApplication.currentEvent
dim globalLocation as NSPointMBS = ev.locationInWindow
dim localLocation as NSPointMBS = owner.TableView.convertPointFromView (globalLocation, nil)
localLocation.Y = 0
col = owner.TableView.columnAtPoint (localLocation)
else
// Click in row / cell
if not owner.Selected (row) then
// deselect all others if the right-click was not inside the current selection - this is to avoid confusion for the user
owner.ListIndex = row
end if
end if
dim base as new MenuItem
if owner._constructContextualMenu (base, System.MouseX, System.MouseY, row, col, me) then
for i as Integer = 1 to base.Count
dim item as ListBoxTVContextMenuItem = new ListBoxTVContextMenuItem (me, base.Item(i-1))
mItems.Append item
super.addItem item
next
end if
mMenu = base
mRow = row
mCol = col
End EventHandler
Sub Clear()
super.removeAllItems
redim mItems(-1)
End Sub
Sub Constructor(ownerRef as WeakRef)
super.Constructor
mOwner = ownerRef
End Sub
Sub MenuItemAction(sender as ListBoxTVContextMenuItem)
dim item as MenuItem = sender.Item
owner._contextualMenuAction item, mRow, mCol
me.Clear
End Sub
Private Function owner() As ListBoxTV
return ListBoxTV (mOwner.Value)
End Function
Property Private mCol As Integer
Property Private mItems() As ListBoxTVContextMenuItem
Property Private mMenu As MenuItem
Property Private mOwner As WeakRef
ListBoxTV
Property Private mRow As Integer
End Class
End Project
See also:
- /MacControls/Listbox and TableView Demos/ListboxTV drop-in/Flat Only/ListBoxTV Simple Demo with DataSource
- /MacControls/Listbox and TableView Demos/ListboxTV drop-in/Flat Only/ListBoxTV TableView
- /MacControls/Listbox and TableView Demos/ListboxTV drop-in/Flat Only/ListboxTV with ContainerControl Cells
- /MacControls/Listbox and TableView Demos/ListboxTV drop-in/Hierarchical & Flat/ListBoxTV OutlineView
- /MacControls/Listbox and TableView Demos/NSOutlineView/Disk Browser
- /MacControls/Listbox and TableView Demos/NSOutlineView/OutlineControl
- /MacControls/Listbox Row Colors
The items on this page are in the following plugins: MBS MacControls Plugin.
