I am seriously getting my butt kicked on this problem. I've been at it for
days without success.
I want to add multiple flavors to a multi-selection drag. Strangely, when I
add multiple flavors
no errors occur during the flavor adding process.
In the below example that I butchered from the databrowser for dummies
series
[so that I could come up with a clean example] when I select multiple items
and do a drag a
window pops up to show how many items were dragged, what the drag flavors
are, how many
flavors were part of that drag. When I perform the drag of 10 items what I
expect to see is a
list of 10 items all with the primary flavor type of 'dfdb', no error and
all with four flavors added.
In the example the first four of the selected items ends up with a different
flavor as the primary
flavor and the first of each drag ends up with six flavors instead of just
four. There were never
six flavors.
Ultimately what I want is for each drag item to have all four flavors added
and I would like to be
able to extract the data associated with those flavors. My program has too
much stuff to boil
down but I use the same method for adding flavors.
The below exhibits exactly the same behavior when adding flavors.
You'll need the "DataBrowser For Dummies.Incl" in order to try this out.
Thank you very much for any help offered,
W.
'~'A
' Runtime : Rntm Appearance.Incl
' CPU : Carbon
' CALL Req'd : Off
'~'B
/*
BUTCHERED/ DOCTORED EXAMPLE USED FOR TESTING TAKEN FROM DBFD
*/
'~'6
Include "DataBrowser For Dummies.Incl"
_DataBrowserForDummiesFlavor = _"dbfd"
Begin Record ItemRecord
Dim parent As DataBrowserItemID
Dim itemID As DataBrowserItemID
Dim favoriteColor As Int
End Record
Begin Globals
Dim gBrowser As ControlRef
Dim gItems(100) As ItemRecord
End Globals
'~'3
Local Fn CreateData
Dim As Long i, parent
parent = 10
For i = 1 To 100
gItems.itemID(i) = i
gItems.favoriteColor(i) = Rnd(_zBlack)
Long If i Mod 10 = 0
gItems.parent(i) = 0
parent += 10
Xelse
gItems.parent(i) = parent
End If
Next
End Fn
'~'3
Clear Local Fn MyItemHelpContent( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
theProperty As DataBrowserPropertyID, ¬
inRequest As HMContentRequest, ¬
outContentProvided As .HMContentProvidedType, ¬
ioHelpContent As .HMHelpContentRec )
outContentProvided.nil% = _kHMContentNotProvided
End Fn
'~'3
clear local
Local Fn MyItemDraw( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
column As DataBrowserPropertyID, ¬
itemState As DataBrowserItemState, ¬
theRect As .Rect, ¬
gdDepth As SInt16, ¬
colorDev As Boolean )
Long If column = _"col3"
Dim myPat As Pattern
If gItems.favoriteColor(itemID) = 0 Then Exit Fn
Color gItems.favoriteColor(itemID) : PaintOval( #theRect )
Long If Fn IsButtonListActive( browser ) = _false
GetIndPattern( myPat, _sysPatListID, 4 )
PenPat( myPat )
PaintOval( #theRect )
End If
Long If ItemState = _kDataBrowserItemIsSelected
Color _zBlack : PenSize(3,3) : FrameOval( #theRect )
End If
Color _zBlack
Xelse
Dim As RGBColor oColor, colour
Dim As CFStringRef @ cfString
GetForeColor( oColor )
Long If itemState == _kDataBrowserItemIsSelected
GetPortHiliteColor( Fn GetWindowPort(Fn GetControlOwner( browser )),
colour )
RGBForeColor( colour )
PaintRect( #theRect )
End If
// I use BlockZero here instead of DEF BLOCKFILL hoping a gain in speed
BlockZero( @colour, Sizeof(colour) )
Long If itemID Mod 10 = 0
colour.red = 0xFFFF
Fn MakeStringRef("Parent",cfString)
Xelse
Fn MakeStringRef("Child",cfString)
colour.blue = 0xFFFF
End If
RGBForeColor( colour )
Long If cfString
itemState = Fn DrawThemeTextBox( cfString, _kThemeApplicationFont,
_kThemeStateActive, _true, #theRect, _teFlushDefault, _nil ) // Draw
anti-aliased colored text
CFRelease(cfString)
End If
RGBForeColor( oColor )
End If
End Fn
'~'3
Clear Local Fn MyItemCompare( browser As ControlRef, ¬
itemOne As DataBrowserItemID, ¬
itemTwo As DataBrowserItemID, ¬
columnID As DataBrowserPropertyID )
Dim result As Boolean
Long If columnID = _"col3"
result = Abs( gItems.favoriteColor(itemOne) < gItems.favoriteColor(itemTwo)
)
End If
End Fn = result
'~'3
Clear Local Fn MyGetContextualMenu( browser As ControlRef, ¬
theMenu As .MenuRef, ¬
helpType As .UInt32, ¬
helpItemString As .CFStringRef, ¬
selection As .AEDesc )
End Fn
'~'3
Clear Local Fn MySelectContextualMenu( browser As ControlRef, ¬
theMenu As MenuRef, ¬
selectionType As UInt32, ¬
menuID As SInt16, ¬
menuItem As MenuItemIndex )
End Fn
'~'3
Clear Local Fn MyAcceptDrag( browser As ControlRef, ¬
theDrag As DragReference, ¬
targetItemID As DataBrowserItemID )
Dim @ itemRef As ItemReference
Dim @ dataSize As size
Dim @ draggedItem As DataBrowserItemID
Dim err As OSStatus
Dim accept As Boolean
def Fn testForMultipleFlavors( browser , theDrag , targetItemID )
Fn testForMultipleFlavors( browser , theDrag , targetItemID )
accept = ( targetItemID Mod 10 == 0 ) And targetItemID !=
_kDataBrowserNoItem
Long If accept
err = Fn GetDragItemReferenceNumber( theDrag, 1, itemRef )
Long If err = _noErr
dataSize = Sizeof(DataBrowserItemID)
err = Fn GetFlavorData( theDrag, ¬
itemRef, ¬
_DataBrowserForDummiesFlavor, ¬
draggedItem, ¬
dataSize, ¬
dataSize )
Long If err = _noErr
accept = (gItems.parent(draggedItem) != targetItemID )
End If
End If
End If
End Fn = accept
'~'3
Clear Local Fn MyAddDragItem( browser As ControlRef, ¬
theDrag As DragReference, ¬
inItemID As DataBrowserItemID, ¬
itemRef As .ItemReference )
Dim As OSStatus err
Dim As Handle selectedItemsHndl
Dim As Str255 message
selectedItemsHndl = Fn ButtonListGetSelectedItems( browser )
Long If selectedItemsHndl
//err = Fn GetDragItemReferenceNumber( theDrag, index, #itemRef )
err = Fn AddDragItemFlavor( theDrag, ¬
itemRef.nil&, ¬
_DataBrowserForDummiesFlavor, ¬
#[selectedItemsHndl], ¬
Fn GetHandleSize(selectedItemsHndl), ¬
0 )
// adding that flavor we can pass text to other applications
message = "BUTCHERED EXAMPLE FOR TESTING PURPOSES"
err = Fn AddDragItemFlavor( theDrag, itemRef.nil&, _"TEXT", @message[1],
message[0], 0 )
err = Fn AddDragItemFlavor( theDrag, itemRef.nil&, _"ABCD", @message[1],
message[0], 0 )
err = Fn AddDragItemFlavor( theDrag, itemRef.nil&, _"EFGH", @message[1],
message[0], 0 )
DisposeHandle( selectedItemsHndl )
End If
End Fn = _true
'~'3
Clear Local Fn testForMultipleFlavors( browser As ControlRef, ¬
theDrag As DragReference, ¬
containerItemID As DataBrowserItemID )
window 99
Dim As UInt32 index
Dim As OSStatus err, flavErr
Dim As size @ dataSize
Dim As ItemReference @ itemRef
Dim As UInt16 @ numItems
dim as UInt16 @itemCnt
DIM AS LONG @findType
err = Fn CountDragItems( theDrag, numItems )
for index = 1 to numItems
err = FN GetDragItemReferenceNumber(theDrag, index, itemRef)
flavErr = fn GetFlavorType (theDrag, itemRef, index, findType)
err = fn CountDragItemFlavors(theDrag, itemRef,@itemCnt )
print index, mki$(findType), findType,flavErr,itemRef,itemCnt
next
End Fn = ( err = _noErr )
Clear Local Fn MyReceiveDrag( browser As ControlRef, ¬
theDrag As DragReference, ¬
containerItemID As DataBrowserItemID )
Dim As UInt32 i
Dim As OSStatus err
Dim As size @ dataSize
Dim As ItemReference @ itemRef
Dim As UInt16 @ numItems
Dim As Handle @ draggedItemsHndl
err = Fn CountDragItems( theDrag, numItems )
Long If numItems
err = Fn GetDragItemReferenceNumber( theDrag, 1, itemRef )
Long If err = _noErr
err = Fn GetFlavorDataSize(theDrag, itemRef,_DataBrowserForDummiesFlavor,
dataSize )
Long If err = _noErr
draggedItemsHndl = Fn NewHandleClear( dataSize )
Long If draggedItemsHndl
err = Fn GetFlavorData( theDrag, ¬
itemRef, ¬
_DataBrowserForDummiesFlavor, ¬
#[draggedItemsHndl], ¬
dataSize, ¬
0 )
Long If err = _noErr
Fn ButtonListRemoveItems( browser, 0, draggedItemsHndl )
draggedItemsHndl..nil& = containerItemID
Fn ButtonListAddItems( browser,0, draggedItemsHndl )
Xref@ droppedItemIDs(_maxInt) As DataBrowserItemID
droppedItemIDs& = draggedItemsHndl
numItems = ( dataSize / Sizeof(DataBrowserItemID) ) - 1
For i = 1 To numItems
gItems.parent( droppedItemIDs(i) ) = containerItemID
Next
End If
End If
End If
End If
End If
If draggedItemsHndl Then DisposeHandle( draggedItemsHndl )
End Fn = ( err = _noErr )
'~'3
Clear Local Fn MyItemDragRegion( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
prop As DataBrowserPropertyID,¬
theRect As .Rect, ¬
dragRgn As RgnHandle )
Dim myRgn As RgnHandle
myRgn = Fn NewRgn
Long If myRgn
OpenRgn
Color gItems.favoriteColor(itemID) : PaintOval( #theRect )
Long If Fn IsItemSelected( browser, itemID )
InvertOval( #theRect )
Color _zBlack : PenSize(3,3) : FrameOval( #theRect )
End If
Color _zBlack
CloseRgn( myRgn )
UnionRgn(dragRgn,myRgn,dragRgn)
DisposeRgn( myRgn )
End If
End Fn
'~'3
Clear Local Fn MyItemHitTest( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
prop As DataBrowserPropertyID,¬
theRect As .Rect, ¬
mouseRect As .Rect )
Dim r As Rect
Dim result As Boolean
Select Fn EmptyRect( #mouseRect )
Case _false : result = Fn SectRect(#theRect, #mouseRect, r)
Case Else : result = Fn PtInRect(mouseRect.top&, #theRect )
End Select
End Fn = result
'~'3
Clear Local Fn MyItemTracking( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
prop As DataBrowserPropertyID,¬
theRect As .Rect, ¬
startPt As Point, ¬
modifiers As EventModifiers )
Dim result As DataBrowserTrackingResult
result = 1
End Fn = result
'~'3
Clear Local Fn MyItemAcceptDrag( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
theProperty As DataBrowserPropertyID, ¬
theRect As .Rect, ¬
theDrag As DragReference )
Dim flags As DataBrowserDragFlags
flags = 1
End Fn = flags
'~'3
Clear Local Fn MyItemReceiveDrag( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
theProperty As DataBrowserPropertyID,¬
dragFlags As DataBrowserDragFlags, ¬
theDrag As DragReference )
Dim result As Boolean
Dim As UInt32 i
Dim As OSStatus err
Dim As size @ dataSize
Dim As ItemReference @ itemRef
Dim As UInt16 @ numItems
Dim As DataBrowserItemID draggedItem(1)
err = Fn GetDragItemReferenceNumber( theDrag, 1, itemRef )
Long If err = _noErr
dataSize = Sizeof( DataBrowserItemID )
err = Fn GetFlavorData( theDrag, ¬
itemRef, ¬
_DataBrowserForDummiesFlavor, ¬
draggedItem(1), ¬
dataSize, ¬
dataSize )
Long If err = _noErr
gItems.favoriteColor(itemID) = gItems.favoriteColor( draggedItem(1) )
Fn ButtonListUpdate( browser )
End If
End If
End Fn = result
'~'3
Clear Local Fn MyItemNotification( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
message As DataBrowserItemNotification )
Dim err As OSStatus
Dim i As Int
Dim subItemCount As Short
Dim subItemID(100) As DataBrowserItemID
Select message
Case _kDataBrowserContainerOpened
subItemCount = 0
For i = 1 To 100
Long If gItems.parent(i) = itemID
subItemCount++
subItemID(subItemCount) = gItems.itemID(i)
End If
Next
subItemID(0) = itemID
err = Fn ButtonListAddItems( browser, subItemCount, subItemID(0))
Case _kDataBrowserSelectionSetChanged
Fn ButtonListUpdate( browser )
End Select
End Fn
'~'3
Clear Local Fn MyEditItem( browser As ControlRef, ¬
item As DataBrowserItemID, ¬
prop As DataBrowserPropertyID,¬
theString As CFStringRef, ¬
maxEditTextRect As .Rect, ¬
shrinkToFit As .Boolean )
Dim result As Boolean
End Fn = result
'~'3
Local Fn MyGetSetItemData( browser As ControlRef, ¬
itemID As DataBrowserItemID, ¬
theProperty As DataBrowserPropertyID, ¬
itemData As DataBrowserItemDataRef,¬
setValue As Boolean )
Dim err As OSStatus : err = _errDataBrowserPropertyNotSupported
Dim icon As IconRef
Dim transform As IconTransformType
Long If setValue = _false
Select theProperty
Case _"col1"
Select itemID Mod 10
Case 0 : icon = Fn GetFileIcon(_nil,_"fldr",_false)
Case Else : icon = Fn GetFileIcon(_nil,_"????",_false)
End Select
Long If icon
err = Fn ButtonListSetIcon( itemData, icon )
If Fn IsItemSelected( browser, itemID ) Then transform = _kTransformSelected
Long If itemID Mod 10 = 0
If Fn IsContainerOpen( browser, itemID ) Then transform += _kTransformOpen
End If
err = Fn ButtonListSetIconTransform( itemData, transform )
err = Fn ReleaseIconRef( icon )
End If
Case _"col2"
err = Fn ButtonListSetString( itemData,"ItemID" + Str$(itemID) )
Case _kDataBrowserItemIsContainerProperty
Long If itemID Mod 10 = 0
err = Fn ButtonListSetBooleanValue( itemData, _true )
End If
End Select
End If
End Fn = err
'~'3
Clear Local Fn MyPlacardDraw ( browser As ControlRef, placard As ControlRef
)
DrawString( Str$(Fn ButtonListCountItems(browser)) + " item(s)" ¬
+ Str$(Fn ButtonListCountSelectedItems(browser))+ " selected")
End Fn
'~'3
Clear Local Fn BuildWindow
Dim list(3) As ColumnRecord
Dim @ browser As ControlRef
Dim itemID(10) As DataBrowserItemID
Dim i As Int
Dim col As Int : col = 1
Dim r As Rect
SetRect( r, 100, 100, 600, 400 )
Appearance Window 1, "DataBrowser For Dummies", @r ,_kDocumentWindowClass,
¬
_kWindowStandardHandlerAttribute _kWindowInWindowMenuAttribute
_kWindowStandardDocumentAttributes
list.procs[_GetSetItemData] = @Fn MyGetSetItemData
list.procs[_ItemNotification] = @Fn MyItemNotification
list.procs[_AcceptDrag] = @Fn MyAcceptDrag
list.procs[_ReceiveDrag] = @Fn MyReceiveDrag
list.procs[_AddDragItem] = @Fn MyAddDragItem
list.procs[_ItemHelpContent] = @Fn MyItemHelpContent
list.procs[_ItemDraw] = @Fn MyItemDraw
list.procs[_ItemCompare] = @Fn MyItemCompare
list.procs[_GetContextualMenu] = @Fn MyGetContextualMenu
list.procs[_SelectContextualMenu] = @Fn MySelectContextualMenu
list.procs[_placardDraw] = @Fn MyPlacardDraw
list.procs[_ItemHitTest] = @Fn MyItemHitTest
list.procs[_ItemTracking] = @Fn MyItemTracking
list.procs[_ItemDragRegion] = @Fn MyItemDragRegion
list.procs[_ItemAcceptDrag] = @Fn MyItemAcceptDrag
list.procs[_ItemReceiveDrag] = @Fn MyItemReceiveDrag
#If 0
// I don't know how those work
list.procs[_ItemAcceptDrag] = @Fn MyItemAcceptDrag
list.procs[_ItemReceiveDrag] = @Fn MyItemReceiveDrag
#Endif
list.autoResizeOnUpdate = _true'_false
list.cellStyle[_cellTextFont] = _helvetica
list.cellStyle[_cellTextSize] = 14
list.cellStyle[_cellTextFace] = _italicBit% _boldBit%
list.cellStyle[_cellTextMode] = _srcOr
list.cellStyle[_cellTextJust] = _teFlushDefault
list.columnID (col) = _"col1"
list.title (col) = "Icon"
list.cellType (col) = _kDataBrowserIconType
list.minWidth (col) = 50
list.maxWidth (col) = 50
list.disclosure (col) = _true
list.cellFlags (col) = _kDataBrowserListViewSelectionColumn
list.headerStyle[_cellTextFont](col) = _sysFont
list.headerStyle[_cellTextSize](col) = 40
list.headerStyle[_cellTextFace](col) = _boldBit%
list.headerStyle[_cellTextMode](col) = _srcCopy
list.headerStyle[_cellTextJust](col) = _teFlushDefault
Dim icon As IconRef
icon = Fn GetFileIcon(_nil,_"fldr",_false)
Long If icon
list.headerType(col) = _kControlContentIconRef
list.headerInfo(col) = icon
End If
col += 1
list.columnID (col) = _"col2"
list.title (col) = "Identity"
list.cellType (col) = _kDataBrowserTextType
list.minWidth (col) = 100
list.maxWidth (col) = 200
list.cellFlags(col) = _kDataBrowserListViewSelectionColumn
list.headerStyle[_cellTextFont](col) = _sysFont
list.headerStyle[_cellTextSize](col) = 12
list.headerStyle[_cellTextFace](col) = _boldBit%
list.headerStyle[_cellTextMode](col) = _srcCopy
list.headerStyle[_cellTextJust](col) = _teFlushDefault
col += 1
list.columnID (col) = _"col3"
list.title (col) = "Color"
list.cellType (col) = _kDataBrowserCustomType
list.minWidth (col) = 80
list.maxWidth (col) = 70
list.cellFlags(col) = _kDataBrowserListViewSelectionColumn
Fn ButtonListCreate( browser, _nil, col, list(0) )
If icon Then col = Fn ReleaseIconRef( icon )
Do
i += 1
itemID(i) = i * 10
Until itemID(i) = 100
Fn ButtonListAddItems( browser, 10, itemID(0) )
End Fn = browser
'~'3
local Fn doMenu
Dim As Long menuID,itemID, i, temp
Dim As OSStatus err
Dim items(1) As DataBrowserItemID
menuID = Menu(_menuID)
itemID = Menu(_itemID)
Select menuID
Case 1
End
'~List View
Case 2
Select itemID
Case 1
// set/remove focus
'~'9
For i = 1 To 5
Fn ButtonListSetFocus( gBrowser, Abs(i Mod 2 == 0 ) )
Delay _secTenth * 5
Next
Case 2
// cell text style
'~'9
Fn ButtonListSetFontStyle( gBrowser, _courier, 16, _italicBit%,_srcCopy,
_teFLushDefault)
Case 3
// row height
'~'9
Fn ButtonListOpenContainer( gBrowser, 10 )
Fn ButtonListShowItem( gBrowser, 8 )
temp = Fn ButtonListGetItemRowHeight( gBrowser, 8 )
For i = temp To 0 Step - 5
Fn ButtonListSetItemRowHeight( gBrowser, 8, i ) : Delay _secTenth*2
Next
Fn ButtonListSetItemRowHeight( gBrowser, 8, temp ) : Delay _secTenth*2
For i = temp To temp * 3 Step 3
Fn ButtonListSetItemRowHeight( gBrowser, 8, i ) : Delay _secTenth*2
Next
Fn ButtonListSetItemRowHeight( gBrowser, 8, temp ) : Delay _secTenth*2
// variable heigth row
Fn ButtonListSetVariableHeightRows( gBrowser, _true )
For i = temp To 0 Step - 5
Fn ButtonListSetItemRowHeight( gBrowser, 8, i ) : Delay _secTenth*2
Next
Fn ButtonListSetItemRowHeight( gBrowser, 8, temp ) : Delay _secTenth*2
For i = temp To temp * 3 Step 3
Fn ButtonListSetItemRowHeight( gBrowser, 8, i ) : Delay _secTenth*2
Next
Fn ButtonListSetItemRowHeight( gBrowser, 8, temp )
Fn ButtonListSetVariableHeightRows( gBrowser, _false )
Case 4
// Theme background (no such thing in OS X)
'~'9
Long If System(_sysvers) < 1000
For i = 1 To 3
Fn ButtonListRemoveBackground( gBrowser ) : Delay _secTenth
Fn ButtonListAddBackground( gBrowser ) : Delay _secTenth
Next
Xelse
ParamText("No Background in OS X","","","")
temp = Fn Alert(1,_nil)
End If
Case 5
// Add/Remove placard + width
'~'9
For i = 1 To 3
Fn ButtonListAddPlacard( gBrowser, 100 * i) : Delay _secTenth*5
Fn ButtonListRemovePlacard( gBrowser ) : Delay _secTenth*5
Next
End Select
'~Items
Case 3
Select itemID
Case 1
// select item (array expected)
'~'9
Fn ButtonListOpenContainer( gBrowser, 60 )
Fn ButtonListDeselectItems( gBrowser, 0, #0 )
items(1) = 55
Fn ButtonListSelectItems( gBrowser, 1, items(0) )
Fn ButtonListShowItem( gBrowser, 55 )
/*
In our examples, we have defined our custom itemRecord
like the following:
Begin Record ItemRecord
Dim parent As DataBrowserItemID
Dim itemID As DataBrowserItemID
Dim favoriteColor As Int
End Record
We can then add to the selection a single item like
shown below:
*/
Dim mySingleItem As ItemRecord
mySingleItem.parent = 0
mySingleItem.itemID = 51
Fn ButtonListSelectItems( gBrowser, 1, mySingleItem )
Case 2
// select all
'~'9
Fn ButtonListSelectItems( gBrowser, _nil, #_nil )
Case 3
// show item
'~'9
For i = 10 To 100
Fn ButtonListCloseContainer( gBrowser, i )
Next
Fn ButtonListShowItem( gBrowser, 43 )
Case 4
// open container
'~'9
For i = 10 To 100 Step 10
Fn ButtonListOpenContainer( gBrowser, i ) : Delay _sectenth * 3
Next
Case 5
// close container
'~'9
For i = 10 To 100 Step 10
Fn ButtonListCloseContainer( gBrowser, i ) : Delay _sectenth * 3
Next
Case 6
// sort container
'~'9
Fn ButtonListOpenContainer( gBrowser, 30 )
Fn ButtonListShowItem( gBrowser, 29 )
Fn ButtonListSetDecreasingSort( gBrowser )
Fn ButtonListSortContainer( gBrowser, 30 )
Case 7
// deactivate cells
'~'9
Fn ButtonListDeactivate( gBrowser )
ParamText("Custom Draw has been altered","To reflect the list view
state","","")
err = Fn Alert(1,_nil)
Case 8
// activate cells
'~'9
Fn ButtonListActivate( gBrowser )
Case 9
// Change target
'~'9
For i = 20 To 100 Step 10
// we remove first all the containers but itemID 10 (will contain all the
others)
Fn ButtonListRemoveItems(gBrowser,1,gItems(i))
// assign a new parent itemID 20 -> parent 10, itemiD 30 -> parent 20, etc.
gItems.parent(i) = i - 10
// reinsert the deleted containers in the list
// this can be done like this, 'cos our ItemRecord
// has been set correctly (see the globals section)
Fn ButtonListAddItems(gBrowser,1,gItems(i))
Next
For i = 10 To 100 Step 10
// change the target to each container
// (for each only the contents will be displayed)
Fn ButtonListSetTarget( gBrowser, i )
Window 1, "Target:"+Str$(gItems.ItemID(i)) : Delay _secTenth * 5
Next
// reset target to itemID 10 (I don't know why, don't accept itemID 0)
Window 1,"Target 10"
Fn ButtonListSetTarget( gBrowser, 10 )
For i = 20 To 100 Step 10
// Open all the containers
Fn ButtonListOpenContainer( gBrowser, i )
// move the view to an item in that container
// so that we can see the hierarchy
Fn ButtonListShowItem(gBrowser, i-1 ) : Delay _secTenth * 3
Next
Delay _sec
// restore all, reset target to 0, remove all items then add them again
Fn ButtonListSetTarget( gBrowser, 0 )
For i = 10 To 100 Step 10
Fn ButtonListRemoveItems(gBrowser,1,gItems(i))
gItems.parent(i) = 0
Fn ButtonListAddItems(gBrowser,1,gItems(i))
Next
Fn ButtonListShowItem( gBrowser, 10 )
End Select
'~Columns
Case 4
Select itemID
Case 1
// header height
'~'9
temp = Fn ButtonListSetHeaderHeight( gBrowser, 100 )
For i = 100 To 0 Step -10
Fn ButtonListSetHeaderHeight( gBrowser, i ) : Delay _sectenth * 3
Next
Delay _sec
If temp > 0 Then Fn ButtonListSetHeaderHeight( gBrowser, temp )
Case 2
// disclosure column
'~'9
Dim As Long columnID, numColumns
numColumns = Fn ButtonListGetColumnCount( gBrowser )
temp = Fn ButtonListGetDisclosureColumn( gBrowser )
For i = 1 To 5
Do
columnID = Fn ButtonListGetDisclosureColumn( gBrowser )
Select Rnd( numColumns )
Case 1 : temp = _"col1"
Case 2 : temp = _"col2"
Case 3 : temp = _"col3"
Case 4 : temp = _"col4"
End Select
Until temp != columnID
Fn ButtonListSetDisclosureColumn( gBrowser, temp ) : Delay _secTenth * 5
Next
Case 3
// sort column
'~'9
numColumns = Fn ButtonListGetColumnCount( gBrowser )
columnID = Fn ButtonListGetSortColumn( gBrowser )
For i = 1 To 5
Do
columnID = Fn ButtonListGetSortColumn( gBrowser )
Select Rnd( numColumns )
Case 1 : temp = _"col1"
Case 2 : temp = _"col2"
Case 3 : temp = _"col3"
Case 4 : temp = _"col4"
End Select
Until temp != columnID
Fn ButtonListSetSortColumn( gBrowser, temp ) : Delay _secTenth * 5
Next
Case 4
// column width
'~'9
temp = Fn ButtonListGetColumnWidth( gBrowser, _"col2" )
For i = 200 To 0 Step -20
Fn ButtonListSetColumnWidth( gBrowser, _"col2", i ) : Delay _sectenth * 3
Next
Delay _sec
Fn ButtonListSetColumnWidth( gBrowser, _"col2", temp )
Case 5
// column position (position starts at 0)
'~'9
numColumns = Fn ButtonListGetColumnCount( gBrowser )
temp = Fn ButtonListGetColumnPosition( gBrowser, _"col1" )
For i = 0 To numColumns - 1
Fn ButtonListSetColumnPosition( gBrowser, _"col1", i ) : Delay _sectenth * 5
Next
Delay _sec
Fn ButtonListSetColumnPosition( gBrowser, _"col1", temp )
Case 6
// add column at position 2 (it will become the third column)
'~'9
Dim col As ColumnRecord
Def Blockfill( @col,Sizeof(ColumnRecord),0)
col.columnID = _"col4"
col.title = "New Column"
col.cellType = _kDataBrowserCustomType
col.minWidth = 100
col.maxWidth = 200
col.headerStyle[_cellTextFace] = _outlineBit%
Fn ButtonListAddColumn( gBrowser, col, 2 )
Case 7
// remove column
'~'9
Fn ButtonListRemoveColumn( gBrowser, _"col4" )
Case 8
// Show/Hide scrollbars
'~'9
Fn ButtonListShowScrollbars( gBrowser, _true, _false ) : Delay _sec
Fn ButtonListShowScrollbars( gBrowser, _false, _true ) : Delay _sec
Fn ButtonListShowScrollbars( gBrowser, _false, _false ): Delay _sec
Fn ButtonListShowScrollbars( gBrowser, _true, _true ) : Delay _sec
Case 9
// Get cell bounds
'~'9
Dim r As Rect
Fn ButtonListOpenContainer( gBrowser, 30 )
Fn ButtonListShowItem( gBrowser, 25 )
Fn ButtonListGetCellRect( gBrowser, 25, _"col3", _nil , r )
PenSize( 3, 3 ) : FrameRect( r )
Case 10
// Get content bounds
'~'9
Fn ButtonListOpenContainer( gBrowser, 30 )
Fn ButtonListShowItem( gBrowser, 25 )
Fn ButtonListGetCellRect( gBrowser, 25, _"col1", _kDataBrowserIconType , r )
PenSize( 3, 3 ) : FrameRect( r )
End Select
End Select
Menu
End Fn
// our menus
Menu 1,0,1,"File"
Menu 1,1,1,"Quit/Q"
Menu 2,0,1,"List View"
Menu 2,1,1,"Set & Remove Focus"
Menu 2,2,1,"Set Text Style"
Menu 2,3,1,"Change Row Height"
Menu 2,4,1,"Add & Remove Theme Background"
Menu 2,5,1,"Add & Remove Placard"
Menu 3,0,1,"Items"
Menu 3,1,1,"Select Items 55 & 51"
Menu 3,2,1,"Select All"
Menu 3,3,1,"Show Item"
Menu 3,4,1,"Open Container"
Menu 3,5,1,"Close Container"
Menu 3,6,1,"Sort Container"
Menu 3,7,1,"Deactivate All"
Menu 3,8,1,"Activate All"
Menu 3,9,1,"Change Target"
Menu 4,0,1,"Columns"
Menu 4,1,1,"Change Header Height"
Menu 4,2,1,"Set Disclosure Column"
Menu 4,3,1,"Sort Colum"
Menu 4,4,1,"Change Width"
Menu 4,5,1,"Change Position"
Menu 4,6,1,"Add Column"
Menu 4,7,1,"Remove Column"
Menu 4,8,1,"Show & Hide Scrollbars"
Menu 4,9,1,"Get Cell Rect"
Menu 4,10,1,"Get Content Rect"
Fn CreateData
gBrowser = Fn BuildWindow
On Menu Fn doMenu
Do
Handleevents
Until 0