blob: ce1c2c9115ed5e2a02e610cf3bdd4f536058f00c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
# Load the tkdnd package
## Make sure that we can find the tkdnd package even if the user has not yet
## installed the package.
if {[catch {package require tkdnd}]} {
set DIR [file dirname [file dirname [file normalize [info script]]]]
source $DIR/library/tkdnd.tcl
foreach dll [glob -type f $DIR/*tkdnd*[info sharedlibextension]] {
tkdnd::initialise $DIR/library ../[file tail $dll] tkdnd
}
}
# Create a widget that will be a drag source.
set text_data "hello from Tk! (\u20ac)"
set file_data [list /tmp/hello\u20ac [info script]]
grid [label .text_drag_source \
-text "Text Drag Source ($text_data)"] -sticky snew -columnspan 2
grid [label .file_drag_source \
-text "File Drag Source ($file_data)"] -sticky snew -columnspan 2
tkdnd::drag_source register .text_drag_source
tkdnd::drag_source register .file_drag_source
bind .text_drag_source <<DragInitCmd>> \
[list drag_source DND_Text $text_data %e %W %s %X %Y %A]
bind .text_drag_source <<DragEndCmd>> \
[list drag_source DND_Text $text_data %e %W %s %X %Y %A]
bind .file_drag_source <<DragInitCmd>> \
[list drag_source DND_Files $file_data %e %W %s %X %Y %A]
bind .file_drag_source <<DragEndCmd>> \
[list drag_source DND_Files $file_data %e %W %s %X %Y %A]
proc drag_source {type data event path state x y action} {
switch $event {
<<DragInitCmd>> {return [list copy $type $data]}
<<DragEndCmd>> {puts "Drag action: $action (type: $type)"}
}
};# drag_source
# Add some custom clipboard formats...
frame .colours
foreach colour {red green blue navy} {
pack [label .colours.$colour -text $colour -fg white -bg $colour] \
-side left -padx 2
tkdnd::drag_source register .colours.$colour
bind .colours.$colour <<DragInitCmd>> \
"list copy DND_Color $colour"
}
grid .colours -sticky snew -columnspan 2
# Create a widget that can be a drop target.
grid [label .drop_target -text {Drop Target:} -bg yellow] \
[label .drop_target_value -text { }] -sticky snew
# Register .drop_target as a drop target of every type!
tkdnd::drop_target register .drop_target *
# During drag and drop, the drop target receives information through 3
# virtual events: <<DropEnter>> <<DropPosition>> <<DropLeave>>
# The fields that can be used in the event callbacks, are given in "cmd",
# while their "label" is given in "itemList"...
set cmd {handle_event %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %CPT %b %D}
set itemList {Event Widget X Y Source_Types Target_Types Source_Actions Action
Common_Source_Types Common_Target_Types Types
Drop_Type Cross_Platform_Drop_Type
Pressed_Keys Data}
# Add the various events...
bind .drop_target <<DropEnter>> $cmd
bind .drop_target <<DropPosition>> $cmd
bind .drop_target <<DropLeave>> $cmd
# Add the generic <<Drop>> event. This will be called when more specilised
# drop event is not found for the drop.
bind .drop_target <<Drop>> $cmd
# Add a specialised <<Drop>> event, when will be called if a file is dropped.
bind .drop_target <<Drop:DND_Files>> $cmd
# Add a special drop command for DND_Color...
bind .drop_target <<Drop:DND_Color>> $cmd
# Create some widgets for showing event info.
foreach item $itemList {
grid [label .[string tolower $item] -text [string map {_ \ } $item]:\
-anchor w] [label .[string tolower $item]_val -width 60 -anchor w \
-background white -foreground navy] -sticky snew -padx 1 -pady 1
}
grid columnconfigure . 1 -weight 1
grid rowconfigure . 1 -weight 1
proc handle_event $itemList {
global itemList
foreach item $itemList {
.[string tolower $item]_val configure -text [set $item]
}
switch -glob $Event {
<<DropEnter>> {$Widget configure -bg green}
<<DropLeave>> {$Widget configure -bg yellow}
<<Drop:DND_Color>> {
$Widget configure -bg yellow
.drop_target_value configure -text $Data
## Convert data into a Tk color: the colour data is a list of 4 elements
## (red green blue opacity), expressed as Hex numbers...
set color "#"
for {set i 0} {$i < 3} {incr i} {
## Just remove the 0x prefix...
append color [string range [lindex $Data $i] 2 end]
}
.drop_target_value configure -background $color -foreground white
}
<<Drop>> -
<<Drop:*>> {
$Widget configure -bg yellow
.drop_target_value configure -text $Data \
-background [. cget -background] -foreground black
}
}
return copy
};# handle_event
|
