Xojo Developer Conference
25/27th April 2018 in Denver.
MBS Xojo Conference
6/7th September 2018 in Munich, Germany.

Platforms to show: All Mac Windows Linux Cross-Platform

/CocoaControls/Listbox and TableView Demos/Dynamic ListBoxTV (Database)
Function:
You find this example project in your Plugins Download as a Xojo (Real Studio) project file within the examples folder: /CocoaControls/Listbox and TableView Demos/Dynamic ListBoxTV (Database)
This example is the version from Sun, 13th May 2017.
Notes: Last modified: Sun, 13th May 2017
Project "Dynamic ListBoxTV (Database).rbp"
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 value = "" then // User has not set any rules for the widths - 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') 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) 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 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
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 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() if not mIgnoreTileEvents then if mMaintainColumnWidths then _recalcColumnWidths() end if end if RaiseEvent didTile 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. 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(txt as String) if mDataSource isA ListBoxTV_Support.ListBoxTVStaticDataSource then ListBoxTV_Support.ListBoxTVStaticDataSource(mDataSource).AddRow txt else break // If you have assigned your own DataSource, then you cannot use AddRow() as that makes little sense end if mLastIndex = mDataSource.DataSource_RowCount-1 _needsReload 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 mLastIndex = -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 mLastIndex 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 mIgnoreReload = true mPendingUpdateColumnWidthExpressions = false 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 mIgnoreReload = 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 mIgnoreReload then return end if if needsRecalcColumnWidths then // A column's WidthActual or WithExpression was set mColumnWidthsDirty = true mPendingUpdateColumnWidthExpressions = 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 End Sub
Private Sub _recalcColumnWidths() mColumnWidthsDirty = false mTableView.columnAutoresizingStyle = NSTableViewMBS.NSTableViewLastColumnOnlyAutoresizingStyle mHadVerticalScroller = me.ScrollView.hasVerticalScroller and not me.ScrollView.verticalScroller.isHidden dim scrollerWidth as Integer if mHadVerticalScroller then scrollerWidth = Ceil (me.ScrollView.verticalScroller.frame.Width) end if dim totalWidth as Integer = me.ScrollView.frameWidth - scrollerWidth 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+1-col, colSpacing, asteriskCount, remainingWidth, actW) call calcColumnWidth (columnWidthCalcTypes.minimum, mCols(col).MinWidthExpression, totalWidth, mCols.Ubound+1-col, colSpacing, asteriskCountMin, remainingMinWidth, minW) call calcColumnWidth (columnWidthCalcTypes.maximum, mCols(col).MaxWidthExpression, totalWidth, mCols.Ubound+1-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 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 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 end if widthOut = space return type End Function
Private Function determineColumnWidthType(calcType as columnWidthCalcTypes, expr as String, ByRef value as Double) As columnWidthTypes 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 declare function frameOfCellAtColumn_Row lib "Cocoa" selector "frameOfCellAtColumn:row:" (o as Integer, col as Integer, row as Integer) as NSRect 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 TableView (Hierarchical).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(mLastIndex, 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 "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 "ListBox TableView (Hierarchical).rbp" instead) • Row Insert + Delete • Font attributes (bold, italic) for entire list defaults and for individual cells
Property DefaultRowHeight As Integer
Property Hierarchical As Boolean
Property InitialValue As String
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 mHadVerticalScroller As Boolean
Property Private mHasDynamicColumnWidths As Boolean
Property Private mHeaderView As NSTableHeaderViewMBS
Property Private mIgnoreReload As Boolean
Property Private mIgnoreTileEvents As Boolean
Property Private mInsideHeaderDrag As Boolean
Property Private mLastIndex As Integer
Property Private mMaintainColumnWidths As Boolean
Property Private mPendingUpdateColumnWidthExpressions 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 NSRect x as Single y as Single w as Single h as Single 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) 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 NSRect, src as NSRect, operation as Integer, fraction as Double, respectFlipped as Boolean, hints as Ptr) #else declare sub drawInRect lib "Cocoa" selector "drawInRect:fromRect:operation:fraction:respectFlipped:hints:" ( _ h as Integer, dst as NSRect, src as NSRect, operation as Integer, fraction as Single, respectFlipped as Boolean, hints as Ptr) #endif dim img as NSImageMBS = cell.nsImage dim dr, zeroRect as NSRect 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 return true End EventHandler
EventHandler Function selectWithFrame(rect as NSRectMBS, controlView as NSViewMBS, text as NSTextMBS, theDelegate as variant, selStart as Integer, selLength as Integer) As boolean break ' not sure when this gets called 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 _Private_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 NSRect x as Single y as Single w as Single h as Single 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:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS CocoaControls Plugin.




Links
MBS Xojo Plugins