summaryrefslogtreecommitdiffstats
path: root/demos/simple_target.tcl
blob: 341cac22615ba908bdf50225b7477cb7a148d253 (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
package require tkdnd
catch {console show}

pack [ttk::button .drop_target -text " Drop Target (I can accept anything!) "] \
      -fill x -padx 20 -pady 20

tkdnd::drop_target register .drop_target *

## Visual feedback:

bind .drop_target <<DropEnter>> {%W state  active}
bind .drop_target <<DropLeave>> {%W state !active}

## Position events:

proc handle_position {widget mouse_x mouse_y drag_source_actions buttons} {
  ## Limit drops to the left half part of the window...

  set x [winfo rootx $widget]
  set w [winfo width $widget]
  set middle [expr {$x + $w / 2.}]
  if {$mouse_x > $middle} {return refuse_drop}
  if {"alt" in $buttons && "link" in $drag_source_actions} {
    return link
  } elseif {"ctrl" in $buttons && "move" in $drag_source_actions} {
    return move
  } elseif {"copy" in $drag_source_actions} {
    return copy
  } else {
    return refuse_drop
  }
};# handle_position

bind .drop_target <<DropPosition>> [list handle_position %W %X %Y %a %b]

## Drop callbacks:

bind .drop_target <<Drop>>           {
  puts "Generic data drop: \"%D\""
  %W state !active
  return %A
}
bind .drop_target <<Drop:DND_Text>>  {
  puts "Dropped text:  \"%D\""
  %W state !active
  return %A
}
bind .drop_target <<Drop:DND_Files>> {
  puts "Dropped files: \"[join %D {, }]\""
  %W state !active
  return %A
}
bind .drop_target <<Drop:DND_HTML>> {
  puts "Dropped HTML: \"[join %D {, }]\""
  %W state !active
  return %A
}
bind .drop_target <<Drop:DND_Color>> {
  puts "Dropped color: \"%D\""
  %W state !active
  return %A
}