pixmapscroll.tcl

来自「Linux下的MSN聊天程序源码」· TCL 代码 · 共 728 行 · 第 1/2 页

			}

			# Set the slider's position:
			set sliderpos [expr {($first * ($newsize - ($arrow1height + $arrow2height))) + $arrow1height}]
			
			# Check to avoid slight moving of scrollbar during resizing when at top or bottom:
			if { [lindex [$self get] 0] == 0 } { set sliderpos $arrow1height }
			if { [lindex [$self get] 1] == 1 } { set sliderpos [expr $newsize - $arrow2height - $slidersize] }
			
			# Make sure the slider doesn't escape the trough!
			if { $sliderpos < $arrow1height } { set sliderpos $arrow1height }
			if { $sliderpos > [expr {$newsize - $arrow1height - $slidersize}] } { set sliderpos [expr {$newsize - $arrow1height - $slidersize}] }
			$canvas coords $sliderimage 0 $sliderpos

		} else {
			set slidersize [lindex [split [expr {$visible * ($newsize - ($arrow1width + $arrow2width))}] .] 0]

			#Make sure slider doesn't get negative size
			if { [image width $sliderbodyimage] < [image width $slidergripimage] } {
				set minsize [expr {[image width $slidertopimage] + [image width $sliderbottomimage] + [image width $slidergripimage]}]
			} else {
				set minsize [expr {[image width $slidertopimage] + [image width $sliderbottomimage] + [image width $sliderbodyimage]}]
			}			
			
			if { $slidersize < $minsize } {
				set slidersize $minsize
			}			


			$sliderimage blank
			$sliderimage copy $slidertopimage
			$sliderimage copy $sliderbodyimage -to [image width $slidertopimage] 0 [expr {$slidersize - [image width $sliderbottomimage]}] [image height $sliderbodyimage]
			$sliderimage copy $sliderbottomimage -to [expr {$slidersize - [image width $sliderbottomimage]}] 0 -shrink

			$sliderimage_hover blank
			$sliderimage_hover copy $slidertopimage_hover
			$sliderimage_hover copy $sliderbodyimage_hover -to [image width $slidertopimage_hover] 0 [expr {$slidersize - [image width $sliderbottomimage_hover]}] [image height $sliderbodyimage_hover]
			$sliderimage_hover copy $sliderbottomimage_hover -to [expr {$slidersize - [image width $sliderbottomimage_hover]}] 0 -shrink

			$sliderimage_pressed blank
			$sliderimage_pressed copy $slidertopimage_pressed
			$sliderimage_pressed copy $sliderbodyimage_pressed -to [image width $slidertopimage_pressed] 0 [expr {$slidersize - [image width $sliderbottomimage_pressed]}] [image height $sliderbodyimage_pressed]
			$sliderimage_pressed copy $sliderbottomimage_pressed -to [expr {$slidersize - [image width $sliderbottomimage_pressed]}] 0 -shrink

			$sliderimage_disabled blank
			$sliderimage_disabled copy $slidertopimage_disabled
			$sliderimage_disabled copy $sliderbodyimage_disabled -to [image width $slidertopimage_disabled] 0 [expr {$slidersize - [image width $sliderbottomimage_disabled]}] [image height $sliderbodyimage_disabled]
			$sliderimage_disabled copy $sliderbottomimage_disabled -to [expr {$slidersize - [image width $sliderbottomimage_disabled]}] 0 -shrink

			set sliderpos [expr {($first * ($newsize - ($arrow1width + $arrow2width))) + $arrow1width}]

			if { $sliderpos < $arrow1width } { set sliderpos $arrow1width }
			if { $sliderpos > [expr {$newsize - $arrow1width - $slidersize}] } { set sliderpos [expr {$newsize - $arrow1width - $slidersize}] }
			$canvas coords $sliderimage $sliderpos 0
		}

		#Drawing "virtual troughs"
		$canvas delete trough1
		$canvas delete trough2
		if { $options(-orient) == "vertical" } {
			$canvas create rectangle 0 $arrow1height [image width $troughimage] $sliderpos -fill "" -outline "" -tag trough1
			$canvas create rectangle 0 [expr {$sliderpos + $slidersize}] [image width $troughimage] [expr {$newsize - $arrow2height}] -fill "" -outline "" -tag trough2
		} else {
			$canvas create rectangle $arrow1width 0 $sliderpos [image height $troughimage] -fill "" -outline "" -tag trough1
			$canvas create rectangle [expr {$sliderpos + $slidersize}] 0 [expr {$newsize - $arrow2width}] [image height $troughimage] -fill "" -outline "" -tag trough2
		}
	}

	method activate { {element "return"} } {
		if { $element == "return" } {
			return $active_element
		}

		if { ($element == "arrow1") || ($element == "arrow2") || ($element == "slider") } {
			set active_element $element
		} else {
			set active_element ""
		}
	}

	method delta { deltaX deltaY } {
		if {$options(-orient) == "vertical" } {
			set number [expr $deltaY.0 / ($newsize - ($arrow1height + $arrow2height))]
		} else {
			set number [expr $deltaX.0 / ($newsize - ($arrow1width + $arrow2width))]
		}

		return $number
	}

	method fraction { x y } {
		if { $options(-orient) == "vertical" } {
			set pos [expr 1 - ($newsize - $y) / $newsize.0]
		} else {
			set pos [expr 1 - ($newsize - $x) / $newsize.0]
		}
		return $pos
	}

	method get { } {
		return [list $first $last]
	}

	method identify { x y } {
		set sliderpos [$canvas coords $sliderimage]
		set trough1coords [$canvas coords trough1]
		set trough2coords [$canvas coords trough2]

		if { $options(-orient) == "vertical" } {
			set slidersize [image height $sliderimage]
			if { $y <= $arrow1height } { return "arrow1" }
			if { $y >= [expr {$newsize - $arrow2height}] } { return "arrow2" }

			if { $y >= [lindex $sliderpos 1] && $y <= [expr {[lindex $sliderpos 1] + $slidersize}] } { return "slider" }

			if { $y >= [lindex trough1coords 1] && $y <= [lindex $trough1coords 3] } { return "trough1" }
			if { $y >= [lindex trough2coords 1] && $y <= [lindex $trough2coords 3] } { return "trough2" }

		} else {
			set slidersize [image width $sliderimage]
			if { $x <= $arrow1width } { return "arrow1" }
			if { $x >= [expr {$newsize - $arrow2width}] } { return "arrow2" }

			if { $x >= [lindex $sliderpos 0] && $x <= [expr {[lindex $sliderpos 0] + $slidersize}] } { return "slider" }

			if { $x >= [lindex $trough1coords 0] && $x <= [lindex $trough1coords 2] } { return "trough1" }
			if { $x >= [lindex $trough2coords 0] && $x <= [lindex $trough2coords 2] } { return "trough2" }
		}
	}

	method set { ord1 ord2 } {
		set first $ord1
		set last $ord2

		set visible [expr {$last - $first}]
		$self DrawScrollbar

		$self HideUnhide
	}


	method moveto { fraction } {
		eval $options(-command) moveto $fraction
		$self DrawScrollbar
	}

	method scroll { number what } {
		set oldtop [lindex [eval $options(-command)] 0]
		eval "$options(-command) scroll $number $what"
		set newtop [lindex [eval $options(-command)] 0]

		if { $options(-orient) == "vertical" } {
			set sliderpos [lindex [$canvas coords $sliderimage] 1]
			$canvas coords $sliderimage 0 [expr {$sliderpos + [delta 0 [expr {$newtop - $oldtop}]]}]
		} else {
			set sliderpos [lindex [$canvas coords $sliderimage] 0]
			$canvas coords $sliderimage [expr {$sliderpos + [delta 0 [expr {$newtop - $oldtop}]]}] 0
		}

	}
		
	method ResetImageDims { } {
		if { $options(-orient) == "vertical" } {
			set arrow1width [set vertical_arrow1width]
			set arrow1height [set vertical_arrow1height]
			set arrow2width [set vertical_arrow2width]
			set arrow2height [set vertical_arrow2height]
		} else {
			set arrow1width [set horizontal_arrow1width]
			set arrow1height [set horizontal_arrow1height]
			set arrow2width [set horizontal_arrow2width]
			set arrow2height [set horizontal_arrow2height]
		}
	}

	proc reloadimages { dir {force 0} } {
		foreach orientation {horizontal vertical} {
			foreach pic {arrow1 arrow2 slidertop sliderbody sliderbottom slidergrip} {
				foreach hov {{} _hover _pressed _disabled} {
					if { [file exists [file join $dir $orientation/${pic}${hov}.gif]] || $force } {
						set ${orientation}_${pic}image${hov} [image create photo ${orientation}_${pic}image${hov} -file [file join $dir $orientation/${pic}${hov}.gif]]
					}
				}
			}
			if { [file exists [file join $dir $orientation/trough.gif]] || $force } {
				set ${orientation}_troughsrcimage [image create photo ${orientation}_troughsrcimage -file [file join $dir $orientation/trough.gif]]
			}
			set ${orientation}_arrow1width [image width [set ${orientation}_arrow1image]]
			set ${orientation}_arrow1height [image height [set ${orientation}_arrow1image]]
			set ${orientation}_arrow2width [image width [set ${orientation}_arrow2image]]
			set ${orientation}_arrow2height [image height [set ${orientation}_arrow2image]]
		}
		
		foreach scrollwidget $scrollbarlist {
			if { [$scrollwidget cget -orient] == "vertical" } {
				$scrollwidget configure -width [set ${orientation}_arrow1width]
			} else {
				$scrollwidget configure -width [set ${orientation}_arrow1height]
			}
			$scrollwidget ResetImageDims
			$scrollwidget DrawScrollbar
		}
	}
}


#Bindings copied straight from Scrollbar bindings
#Can't just use the Scrollbar tag as they aren't bound for windows or mac

bind Pixmapscroll <Enter> {
    if {$tk_strictMotif} {
	set tk::Priv(activeBg) [%W cget -activebackground]
	%W configure -activebackground [%W cget -background]
    }
    %W activate [%W identify %x %y]
}
bind Pixmapscroll <Motion> {
    %W activate [%W identify %x %y]
}

# The "info exists" command in the following binding handles the
# situation where a Leave event occurs for a scrollbar without the Enter
# event.  This seems to happen on some systems (such as Solaris 2.4) for
# unknown reasons.

bind Pixmapscroll <Leave> {
    if {$tk_strictMotif && [info exists tk::Priv(activeBg)]} {
	%W configure -activebackground $tk::Priv(activeBg)
    }
    %W activate {}
}
bind Pixmapscroll <1> {
    tk::ScrollButtonDown %W %x %y
}
bind Pixmapscroll <B1-Motion> {
    tk::ScrollDrag %W %x %y
}
bind Pixmapscroll <B1-B2-Motion> {
    tk::ScrollDrag %W %x %y
}
bind Pixmapscroll <ButtonRelease-1> {
    tk::ScrollButtonUp %W %x %y
}
bind Pixmapscroll <B1-Leave> {
    # Prevents <Leave> binding from being invoked.
}
bind Pixmapscroll <B1-Enter> {
    # Prevents <Enter> binding from being invoked.
}
bind Pixmapscroll <2> {
    tk::ScrollButton2Down %W %x %y
}
bind Pixmapscroll <B1-2> {
    # Do nothing, since button 1 is already down.
}
bind Pixmapscroll <B2-1> {
    # Do nothing, since button 2 is already down.
}
bind Pixmapscroll <B2-Motion> {
    tk::ScrollDrag %W %x %y
}
bind Pixmapscroll <ButtonRelease-2> {
    tk::ScrollButtonUp %W %x %y
}
bind Pixmapscroll <B1-ButtonRelease-2> {
    # Do nothing:  B1 release will handle it.
}
bind Pixmapscroll <B2-ButtonRelease-1> {
    # Do nothing:  B2 release will handle it.
}
bind Pixmapscroll <B2-Leave> {
    # Prevents <Leave> binding from being invoked.
}
bind Pixmapscroll <B2-Enter> {
    # Prevents <Enter> binding from being invoked.
}
bind Pixmapscroll <Control-1> {
    tk::ScrollTopBottom %W %x %y
}
bind Pixmapscroll <Control-2> {
    tk::ScrollTopBottom %W %x %y
}

bind Pixmapscroll <Up> {
    tk::ScrollByUnits %W v -1
}
bind Pixmapscroll <Down> {
    tk::ScrollByUnits %W v 1
}
bind Pixmapscroll <Control-Up> {
    tk::ScrollByPages %W v -1
}
bind Pixmapscroll <Control-Down> {
    tk::ScrollByPages %W v 1
}
bind Pixmapscroll <Left> {
    tk::ScrollByUnits %W h -1
}
bind Pixmapscroll <Right> {
    tk::ScrollByUnits %W h 1
}
bind Pixmapscroll <Control-Left> {
    tk::ScrollByPages %W h -1
}
bind Pixmapscroll <Control-Right> {
    tk::ScrollByPages %W h 1
}
bind Pixmapscroll <Prior> {
    tk::ScrollByPages %W hv -1
}
bind Pixmapscroll <Next> {
    tk::ScrollByPages %W hv 1
}
bind Pixmapscroll <Home> {
    tk::ScrollToPos %W 0
}
bind Pixmapscroll <End> {
    tk::ScrollToPos %W 1
}

if {![catch {tk windowingsystem} wsystem] && $wsystem == "x11"} {
    bind Pixmapscroll <MouseWheel> {
        tk::ScrollByUnits %W v [expr {- (%D)}]
    }
    bind Pixmapscroll <Option-MouseWheel> {
        tk::ScrollByUnits %W v [expr {-10 * (%D)}]
    }
    bind Pixmapscroll <Shift-MouseWheel> {
        tk::ScrollByUnits %W h [expr {- (%D)}]
    }
    bind Pixmapscroll <Shift-Option-MouseWheel> {
        tk::ScrollByUnits %W h [expr {-10 * (%D)}]
    }
} else {
    bind Pixmapscroll <ButtonPress-5> {
        tk::ScrollByUnits %W v 1
    }
    bind Pixmapscroll <ButtonPress-4> {
        tk::ScrollByUnits %W v -1
    }

    bind Pixmapscroll <Option-ButtonPress-5> {
        tk::ScrollByUnits %W v 10
    }
    bind Pixmapscroll <Option-ButtonPress-4> {
        tk::ScrollByUnits %W v -10
    }

    bind Pixmapscroll <Shift-ButtonPress-5> {
        tk::ScrollByUnits %W h 1
    }
    bind Pixmapscroll <Shift-ButtonPress-4> {
        tk::ScrollByUnits %W h -1
    }

    bind Pixmapscroll <Shift-Option-ButtonPress-5> {
        tk::ScrollByUnits %W h 10
    }
    bind Pixmapscroll <Shift-Option-ButtonPress-4> {
        tk::ScrollByUnits %W h -10
    }
}