From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:46:37 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>ColorDDExample</name> <environment>Examples</environment> <super>UI.ApplicationModel</super> <private>false</private> none colorLayer color sampleList sampleText sampleTable <imports></imports> <category>Examples-Help</category> <attributes> <package>ColorDragDrop-Example</package> </attributes> </class> <comment> Examples.ColorDDExample
ColorDDExample class demonstrates how to enable drag and drop in a VisualWorks application.
</comment> <methods> Examples.ColorDDExample <category>actions</category>
applyColor Dialog warn: 'Drop a color on this button to set the foreground color of the demo widgets.'
applyMoreColor Dialog warn: 'Drag to set the foreground color; shift-drag to set the background color.'
backgroundColor: aColor "For each sample widget, change the indicated color layer." | wrapper lookPref | self sampleWidgets do: [ :widgetID | wrapper := (self builder componentAt: widgetID). lookPref := wrapper lookPreferences backgroundColor: aColor. wrapper lookPreferences: lookPref].
foregroundColor: aColor "For each sample widget, change the indicated color layer." | wrapper lookPref | self sampleWidgets do: [ :widgetID | wrapper := (self builder componentAt: widgetID). lookPref := wrapper lookPreferences foregroundColor: aColor. wrapper lookPreferences: lookPref].
selectionBackgroundColor: aColor "For each sample widget, change the indicated color layer." | wrapper lookPref | self sampleWidgets do: [ :widgetID | wrapper := (self builder componentAt: widgetID). lookPref := wrapper lookPreferences selectionBackgroundColor: aColor. wrapper lookPreferences: lookPref].
selectionForegroundColor: aColor "For each sample widget, change the indicated color layer." | wrapper lookPref | self sampleWidgets do: [ :widgetID | wrapper := (self builder componentAt: widgetID). lookPref := wrapper lookPreferences selectionForegroundColor: aColor. wrapper lookPreferences: lookPref].
</methods> <methods> Examples.ColorDDExample <category>drop target - button1</category>
applyColorDrop: aDragContext "A drop has occured in the Apply Color button. If the drop is permitted, set the foreground color of the demonstration widgets to be the dragged color choice. Restore the button to its former visual state and return an effect symbol for possible use in the colorDrag method." | dict aColor | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. "Extract the color choice from the dragged data and turn it into a color value." dict := aDragContext sourceData clientData. aColor := ColorValue perform: (dict at: #colorChoice). "Restore the button to its former state." (self builder componentAt: #applyColorButton) widget isInTransition: false. "Set the foreground color of the demonstration widgets." self foregroundColor: aColor. "Return an effect symbol." ^#dropEffectMove.
applyColorEnter: aDragContext "A drag has entered the bounds of the Apply Color button. Test whether a drop would be permitted here with this data. If so, cause the button to be highlighted as if it were pressed, and return a symbol that indicates the feedback to be given to the user." aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. (self builder componentAt: #applyColorButton) widget isInTransition: true. ^#dropEffectMove.
applyColorExit: aDragContext "A drag has exited the Apply Color button without dropping. Test whether a drop would have been permitted here with this data. If so, restore the button to its former state, and return a symbol that indicates the feedback to be given to the user." aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. (self builder componentAt: #applyColorButton) widget isInTransition: false. ^#dropEffectNone.
applyColorOver: aDragContext "A drag is over the Apply Color button. Test whether a drop would be permitted here with this data. If so, return a symbol that indicates the feedback to be given to the user. The DragDropManager uses this symbol to determine the pointer shape." aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. ^#dropEffectMove.
</methods> <methods> Examples.ColorDDExample <category>drop target - button2</category>
applyMoreColorDrop: aDragContext "A drop has occured in the Apply More Color button. If the drop is permitted, obtain the dragged color. Then test whether the shift key is down. If so, set the background color of the demonstration widgets. If not, set their foreground color. Restore the button to its former visual state and return an effect symbol for possible use in the colorDrag method." | dict widget aColor | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. "Extract the color choice from the dragged data and turn it into a color value." dict := aDragContext sourceData clientData. aColor := ColorValue perform: (dict at: #colorChoice). "Give the drop target the label that was saved on entry." dict := aDragContext dropTarget clientData. widget := dict at: #widget. widget label: (dict at: #label). aDragContext dropTarget clientData: nil. "Set the color of the demonstration widgets, based on the shift key position." aDragContext shiftDown ifTrue: [self backgroundColor: aColor. ^#dropEffectCopy]. self foregroundColor: aColor. ^#dropEffectMove.
applyMoreColorEnter: aDragContext "A drag has entered the bounds of the Apply More Color button. Test whether a drop would be permitted here with this data. If so, store the current label of the button. Then test whether the shift key is down. Based on this test, change the button's label and return a symbol that indicates the feedback to be given to the user." | widget dict | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. "Record the button's initial state in a dictionary in the drag context." widget := (self builder componentAt: #applyMoreColorButton) widget. dict := IdentityDictionary new. dict at: #widget put: widget. dict at: #label put: widget label. aDragContext dropTarget clientData: dict. aDragContext shiftDown ifTrue: [widget labelString: 'Background'. ^#dropEffectCopy]. widget labelString: 'Foreground'. ^#dropEffectMove.
applyMoreColorExit: aDragContext "A drag has exited the Apply More Color button without dropping. Test whether a drop would have been permitted here with this data. If so, restore the button to its former state, and return a symbol that indicates the feedback to be given to the user." | dict widget | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. "Give the drop target the label that was saved on entry." dict := aDragContext dropTarget clientData. widget := dict at: #widget. widget label: (dict at: #label). aDragContext dropTarget clientData: nil. ^#dropEffectNone.
applyMoreColorOver: aDragContext "A drag is over the Apply More Color button. Test whether a drop would be permitted here with this data. If so, test whether the shift key is down. Based on this test, return a symbol that indicates the feedback to be given to the user. The DragDropManager uses this symbol to determine the pointer shape." | widget | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. widget := aDragContext dropTarget clientData at: #widget. aDragContext shiftDown ifTrue: [widget label text string = 'Background' ifFalse: [widget labelString: 'Background']. ^#dropEffectCopy]. widget label text string = 'Foreground' ifFalse: [widget labelString: 'Foreground']. ^#dropEffectMove.
</methods> <methods> Examples.ColorDDExample <category>aspects</category>
color ^color
colorLayer ^colorLayer
sampleList ^sampleList
sampleTable ^sampleTable
sampleText ^sampleText
</methods> <methods> Examples.ColorDDExample <category>drag source</category>
colorDrag: aController "Drag the currently selected color. Provide all available information about the context of the color so that the drop target can use whatever it needs." | ds dm data | data := DragDropData new. data key: #colorChoice. data contextWindow: self builder window. data contextWidget: aController view. data contextApplication: self. data clientData: IdentityDictionary new. data clientData at: #colorChoice put: self color selection. ds := DropSource new. dm := DragDropManager withDropSource: ds withData: data. dm doDragDrop
colorWantToDrag: aController "Determine whether to permit a drag to start from this widget. In this case, make sure there is data to drag and that there is a selection in the color list." ^self color list size > 0 and: [self color selection notNil]
</methods> <methods> Examples.ColorDDExample <category>drop target - list</category>
colorLayerDrop: aDragContext "A drop has occur in the list of color layers. If the drop is permitted, combine the dragged color choice and the targeted color layer to change the color of the appropriate parts of the demonstration widgets. Return an effect symbol for possible use in the colorDrag method." | dict aColor widget idx aLayer | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. "Extract the color choice from the dragged data and turn it into a color value." dict := aDragContext sourceData clientData. aColor := ColorValue perform: (dict at: #colorChoice). "Obtain the index of the target emphasis from the drop target. Use this index to obtain the chosen color layer from the color layer list." widget := aDragContext dropTarget clientData at: #widget. idx := widget targetIndex. idx = 0 ifTrue: [^#dropEffectNone]. aLayer := self colorLayer listHolder value at: idx. "Cause the chosen color layer to appear selected in the list." self colorLayer selectionIndexHolder value: idx. "Discard the saved drop target state." aDragContext dropTarget clientData: nil. "Change the color of the targeted color layer in the demo widgets." aLayer = 'Foreground' ifTrue: [self foregroundColor: aColor]. aLayer = 'Background' ifTrue: [self backgroundColor: aColor]. aLayer = 'Selection Foreground' ifTrue: [self selectionForegroundColor: aColor]. aLayer = 'Selection Background' ifTrue: [self selectionBackgroundColor: aColor]. ^#dropEffectMove.
colorLayerEnter: aDragContext "A drag has entered the bounds of the list of color layers. Test whether a drop would be permitted here with this data. If so, save the initial state of the color layer list, give focus to the list, and return a symbol that indicates the feedback to be given to the user." | dict widget | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. "Record the list's initial state in a dictionary in the drag context." widget := (self builder componentAt: #colorLayerList) widget. dict := IdentityDictionary new. dict at: #widget put: widget. dict at: #targetIndex put: widget targetIndex. dict at: #hasFocus put: widget hasFocus. aDragContext dropTarget clientData: dict. "Give focus to the color layer list, and then return an effect symbol." widget hasFocus: true. ^#dropEffectMove
colorLayerExit: aDragContext "A drag has exited the list of color layers without dropping. Test whether a drop would have been permitted here with this data. If so, restore the initial state of the color layer list, and return a symbol that indicates the feedback to be given to the user." | dict widget | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. "Reset the drop target with the state that was saved on entry." dict := aDragContext dropTarget clientData. widget := dict at: #widget. widget targetIndex: (dict at: #targetIndex). widget hasFocus: (dict at: #hasFocus). "Discard the saved drop target state." aDragContext dropTarget clientData: nil. ^#dropEffectNone
colorLayerOver: aDragContext "A drag is over the list of color layers. Test whether a drop would be permitted here with this data. If so, tell the list to scroll the target emphasis when the pointer moves. Then return a symbol that indicates the feedback to be given to the user. The DragDropManager uses this symbol to determine the pointer shape." | list | aDragContext key == #colorChoice ifFalse: [^#dropEffectNone]. "Track the pointer's movement in the list with target emphasis." list := aDragContext dropTarget clientData at: #widget. list showDropFeedbackIn: aDragContext allowScrolling: true. "Return an effect symbol." ^#dropEffectMove
</methods> <methods> Examples.ColorDDExample <category>initialize-release</category>
initialize | tableList | color := SelectionInList with: #(#white #black #red #green #blue #cyan #magenta #yellow ) asList. colorLayer := SelectionInList with: #('Foreground' 'Background' 'Selection Foreground' 'Selection Background' ) asList. "Sample data for demonstration widgets" sampleList := SelectionInList with: ColorValue constantNames asList. tableList := TwoDList on: #( 'Red' 'Cyan' 'Green' 'Magenta' 'Blue' 'Yellow' ) columns: 2 rows: 3. sampleTable := TableInterface new selectionInTable: (SelectionInTable with: tableList). sampleText := ColorValue comment asValue.
</methods> <methods> Examples.ColorDDExample <category>private</category>
sampleWidgets ^#( #actionButton #checkBox #radioButton #menuButton #inputField #slider #label #divider #box #region #list #table #textEditor )
</methods> <methods> Examples.ColorDDExample class <category>interface specs</category>
windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" <resource: #canvas> ^#(#FullSpec #window: #(#WindowSpec #label: 'ColorExample with Drag and Drop' #min: #(#Point 40 20 ) #bounds: #(#Rectangle 371 370 999 744 ) ) #component: #(#SpecCollection #collection: #( #(#DividerSpec #layout: #(#Rectangle -7 130 311 134 ) #orientation: #vertical ) #(#DividerSpec #layout: #(#Rectangle 353 20 450 356 ) #orientation: #vertical ) #(#LabelSpec #layout: #(#Point 40 7 ) #label: 'Drag a color...' ) #(#SequenceViewSpec #properties: #(#PropertyListDictionary #dragStartSelector #colorDrag: #dragOkSelector #colorWantToDrag: ) #layout: #(#Rectangle 18 34 152 220 ) #name: #colorList #model: #color #useModifierKeys: true #selectionType: #highlight ) #(#CompositeSpecCollection #collection: #( #(#ActionButtonSpec #layout: #(#Rectangle 10 7 59 27 ) #name: #actionButton #label: 'Action' #defaultable: true ) #(#CheckBoxSpec #layout: #(#Point 10 32 ) #name: #checkBox #label: 'Check Box' ) #(#RadioButtonSpec #layout: #(#Point 7 55 ) #name: #radioButton #label: 'Radio Button' ) #(#MenuButtonSpec #layout: #(#Rectangle 5 91 105 116 ) #name: #menuButton #label: 'Choice1' ) #(#InputFieldSpec #layout: #(#Rectangle 6 121 106 142 ) #name: #inputField ) #(#SliderSpec #layout: #(#Rectangle 7 150 87 174 ) #name: #slider #orientation: #horizontal ) #(#LabelSpec #layout: #(#Point 5 187 ) #name: #label #label: 'Label' ) #(#DividerSpec #layout: #(#Rectangle 6 220 106 224 ) #name: #divider ) #(#GroupBoxSpec #layout: #(#Rectangle 5 224 56 282 ) #name: #box #label: 'Box' ) #(#RegionSpec #layout: #(#Rectangle 0 287 74 337 ) #name: #region #lineWidth: 4 #regionType: #ellipse ) #(#SequenceViewSpec #layout: #(#Rectangle 149 0 250 95 ) #name: #list #model: #sampleList ) #(#TableViewSpec #layout: #(#Rectangle 149 118 250 213 ) #name: #table #model: #sampleTable #showHGrid: true #showVGrid: true ) #(#TextEditorSpec #layout: #(#Rectangle 149 237 250 332 ) #name: #textEditor #model: #sampleText ) ) #compositeSpec: #(#CompositeSpec #layout: #(#Rectangle 364 31 614 365 ) ) ) #(#LabelSpec #layout: #(#Point 425 8 ) #label: 'Color Demonstration:' ) #(#LabelSpec #layout: #(#Point 188 190 ) #label: '...or to a list item:' ) #(#SequenceViewSpec #properties: #(#PropertyListDictionary #dragExitSelector #colorLayerExit: #dragEnterSelector #colorLayerEnter: #dropSelector #colorLayerDrop: #dragOverSelector #colorLayerOver: ) #layout: #(#Rectangle 180 219 334 353 ) #name: #colorLayerList #model: #colorLayer #useModifierKeys: true #selectionType: #highlight ) #(#ActionButtonSpec #properties: #(#PropertyListDictionary #dragExitSelector #applyMoreColorExit: #dragEnterSelector #applyMoreColorEnter: #dropSelector #applyMoreColorDrop: #dragOverSelector #applyMoreColorOver: ) #layout: #(#Rectangle 180 133 332 171 ) #name: #applyMoreColorButton #model: #applyMoreColor #label: 'Apply More Color' #defaultable: true ) #(#LabelSpec #layout: #(#Point 187 87 ) #label: '...or to this button:' ) #(#ActionButtonSpec #properties: #(#PropertyListDictionary #dragExitSelector #applyColorExit: #dragEnterSelector #applyColorEnter: #dropSelector #applyColorDrop: #dragOverSelector #applyColorOver: ) #layout: #(#Rectangle 181 34 335 70 ) #name: #applyColorButton #model: #applyColor #label: 'Apply Color' #defaultable: true ) #(#LabelSpec #layout: #(#Point 195 7 ) #label: '...to this button:' ) #(#LabelSpec #layout: #(#Point 180 107 ) #label: '(try Shift-Drag, too)' ) ) ) )
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>ApplicationModel</name> <environment>UI</environment> <super>UI.Model</super> <private>false</private> none builder uiSession eventHandlers savedWindowInformation <imports></imports> <category>UIBuilder-Framework</category> <attributes> <package>UIBuilder-Framework</package> </attributes> </class>