I386LINUX/util/I386LINUX/lib/blt2.4/demos/dragdrop.tcl

   1 #!/home/people/tkys/Eos/util/I386LINUX/bin/bltwish
   2 #!../bltwish
   3 source bltDemo.tcl
   4 # ----------------------------------------------------------------------
   5 # This procedure is invoked each time a token is grabbed from the
   6 # sample window.  It configures the token to display the current
   7 # color, and returns the color value that is later passed to the
   8 # target handler.
   9 # ----------------------------------------------------------------------
  10 proc package_color {token} {
  11     set bg [.sample cget -background]
  12     set fg [.sample cget -foreground]
  13
  14     $token.label configure -background $bg -foreground $fg
  15     return $bg
  16 }
  17
  18 # ----------------------------------------------------------------------
  19 # Main application window...
  20 # ----------------------------------------------------------------------
  21 label .sample -text "Color" -height 2 -borderwidth 3 -relief sunken
  22
  23 #
  24 # Set up the color sample as a drag&drop source for "color" values:
  25 #
  26 drag&drop source .sample -packagecmd {package_color %t}
  27 drag&drop source .sample handler color
  28
  29 #
  30 # Set up the color sample as a drag&drop target for "color" values:
  31 #
  32 drag&drop target .sample handler color {set_color %v}
  33
  34 #
  35 # Establish the appearance of the token window:
  36 #
  37 set token [drag&drop token .sample]
  38 label $token.label -text "Color"
  39 pack $token.label
  40
  41 scale .redScale -label "Red" -orient horizontal \
  42     -from 0 -to 255 -command adjust_color
  43 frame .redSample -width 20 -height 20 -borderwidth 3 -relief sunken
  44
  45 scale .greenScale -label "Green" -orient horizontal \
  46     -from 0 -to 255 -command adjust_color
  47 frame .greenSample -width 20 -height 20 -borderwidth 3 -relief sunken
  48
  49 scale .blueScale -label "Blue" -orient horizontal \
  50     -from 0 -to 255 -command adjust_color
  51 frame .blueSample -width 20 -height 20 -borderwidth 3 -relief sunken
  52
  53 # ----------------------------------------------------------------------
  54 # This procedure loads a new color value into this editor.
  55 # ----------------------------------------------------------------------
  56 proc set_color {cval} {
  57     set rgb [winfo rgb . $cval]
  58
  59     set rval [expr round([lindex $rgb 0]/65535.0*255)]
  60     .redScale set $rval
  61
  62     set gval [expr round([lindex $rgb 1]/65535.0*255)]
  63     .greenScale set $gval
  64
  65     set bval [expr round([lindex $rgb 2]/65535.0*255)]
  66     .blueScale set $bval
  67 }
  68
  69 # ----------------------------------------------------------------------
  70 # This procedure is invoked whenever an RGB slider changes to
  71 # update the color samples in this display.
  72 # ----------------------------------------------------------------------
  73 proc adjust_color {args} {
  74     set rval [.redScale get]
  75     .redSample configure -background [format "#%.2x0000" $rval]
  76     set gval [.greenScale get]
  77     .greenSample configure -background [format "#00%.2x00" $gval]
  78     set bval [.blueScale get]
  79     .blueSample configure -background [format "#0000%.2x" $bval]
  80
  81     .sample configure -background \
  82         [format "#%.2x%.2x%.2x" $rval $gval $bval]
  83     if {$rval+$gval+$bval < 1.5*255} {
  84         .sample configure -foreground white
  85     } else {
  86         .sample configure -foreground black
  87     }
  88 }
  89
  90 table . .sample      0,0 -columnspan 2 -fill both -pady {0 4}
  91 table . .redScale    1,0 -fill both
  92 table . .redSample   1,1 -fill both
  93 table . .greenScale  2,0 -fill both
  94 table . .greenSample 2,1 -fill both
  95 table . .blueScale   3,0 -fill both
  96 table . .blueSample  3,1 -fill both