Bwidget Source Code
Check-in [5ab352a476]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:BWidget::bindMiddleMouseMovement added
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5ab352a476167384d138f454114f1c9012daa616
User & Date: oberdorfer 2009-09-08 20:28:07
Context
2009-09-08
20:33
ttk style related change done check-in: eaa66ce996 user: oberdorfer tags: trunk
20:28
BWidget::bindMiddleMouseMovement added check-in: 5ab352a476 user: oberdorfer tags: trunk
19:55
ttk style related code change check-in: 3193692912 user: oberdorfer tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to utils.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
...
172
173
174
175
176
177
178


179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
...
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
...
673
674
675
676
677
678
679
680


























# ----------------------------------------------------------------------------
#  utils.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: utils.tcl,v 1.16 2009/09/03 17:23:30 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - GlobalVar::exists
#     - GlobalVar::setvarvar
#     - GlobalVar::getvarvar
#     - BWidget::assert
#     - BWidget::clonename
#     - BWidget::get3dcolor
#     - BWidget::XLFDfont
#     - BWidget::place
#     - BWidget::grab
#     - BWidget::focus

# ----------------------------------------------------------------------------

namespace eval GlobalVar {
    proc use {} {}
}


................................................................................
}


# ----------------------------------------------------------------------------
#  Command BWidget::get3dcolor
# ----------------------------------------------------------------------------
proc BWidget::get3dcolor { path bgcolor } {


    foreach val [winfo rgb $path $bgcolor] {
        lappend dark [expr {60*$val/100}]
        set tmp1 [expr {14*$val/10}]
        if { $tmp1 > 65535 } {
            set tmp1 65535
        }
        set tmp2 [expr {(65535+$val)/2}]
        lappend light [expr {($tmp1 > $tmp2) ? $tmp1:$tmp2}]
    }
    return [list [eval format "#%04x%04x%04x" $dark] [eval format "#%04x%04x%04x" $light]]
}


# ----------------------------------------------------------------------------
#  Command BWidget::XLFDfont
# ----------------------------------------------------------------------------
proc BWidget::XLFDfont { cmd args } {
................................................................................
            -size    { set index 7 }
            default  { return -code error "XLFDfont: option incorrecte: $option" }
        }
        set lfont [lreplace $lfont $index $index $value]
    }
    return [join $lfont "-"]
}



# ----------------------------------------------------------------------------
#  Command BWidget::place
# ----------------------------------------------------------------------------
#
# Notes:
................................................................................
	# style::as and Tk 8.5 have global bindings
	# Only enable these if no global binding for them exists
	bind $widget <Button-4> {event generate %W <MouseWheel> -delta  120}
	bind $widget <Button-5> {event generate %W <MouseWheel> -delta -120}
    }
}

 	  	 




























|












>







 







>
>









|







 







<







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
...
222
223
224
225
226
227
228

229
230
231
232
233
234
235
...
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
# ----------------------------------------------------------------------------
#  utils.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: utils.tcl,v 1.17 2009/09/08 20:28:07 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - GlobalVar::exists
#     - GlobalVar::setvarvar
#     - GlobalVar::getvarvar
#     - BWidget::assert
#     - BWidget::clonename
#     - BWidget::get3dcolor
#     - BWidget::XLFDfont
#     - BWidget::place
#     - BWidget::grab
#     - BWidget::focus
#     - BWidget::bindMiddleMouseMovement
# ----------------------------------------------------------------------------

namespace eval GlobalVar {
    proc use {} {}
}


................................................................................
}


# ----------------------------------------------------------------------------
#  Command BWidget::get3dcolor
# ----------------------------------------------------------------------------
proc BWidget::get3dcolor { path bgcolor } {
    set fmt "#%04x%04x%04x"

    foreach val [winfo rgb $path $bgcolor] {
        lappend dark [expr {60*$val/100}]
        set tmp1 [expr {14*$val/10}]
        if { $tmp1 > 65535 } {
            set tmp1 65535
        }
        set tmp2 [expr {(65535+$val)/2}]
        lappend light [expr {($tmp1 > $tmp2) ? $tmp1:$tmp2}]
    }
    return [list [eval format $fmt $dark] [eval format $fmt $light]]
}


# ----------------------------------------------------------------------------
#  Command BWidget::XLFDfont
# ----------------------------------------------------------------------------
proc BWidget::XLFDfont { cmd args } {
................................................................................
            -size    { set index 7 }
            default  { return -code error "XLFDfont: option incorrecte: $option" }
        }
        set lfont [lreplace $lfont $index $index $value]
    }
    return [join $lfont "-"]
}



# ----------------------------------------------------------------------------
#  Command BWidget::place
# ----------------------------------------------------------------------------
#
# Notes:
................................................................................
	# style::as and Tk 8.5 have global bindings
	# Only enable these if no global binding for them exists
	bind $widget <Button-4> {event generate %W <MouseWheel> -delta  120}
	bind $widget <Button-5> {event generate %W <MouseWheel> -delta -120}
    }
}


# ----------------------------------------------------------------------------
# support for middle mouse button movement
# ----------------------------------------------------------------------------

proc BWidget::bindMiddleMouseMovement { widget } {
  variable __private

  bind $widget <2> {
     set BWidget::__private(x) %x
     set BWidget::__private(y) %y
     %W configure -cursor fleur
  }
  bind $widget <B2-ButtonRelease> {
     %W configure -cursor ""
  }

  bind $widget <B2-Motion> {
      set scrollspeed 2
      set xdir 1
      set ydir 1
      if { %x > $BWidget::__private(x) } {set xdir -1}
      if { %y > $BWidget::__private(y) } {set ydir -1}
      catch {%W xview scroll [expr $xdir * $scrollspeed] units}
      catch {%W yview scroll [expr $ydir * $scrollspeed] units}
  }
}