pixmapscroll.tcl

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

#Pixmapscroll 0.9 by Arieh Schneier and Tom Jenkins
#A scrollbar widget that uses pixmaps so you can have pretty-fied tk scrollbars!

package require snit
package provide pixmapscroll 0.9

interp alias {} scrollbar {} pixmapscrollbar

snit::widgetadaptor pixmapscrollbar {

	typevariable scrollbarlist {}

	foreach orientation {horizontal vertical} {
		foreach pic {arrow1 arrow2 slidertop sliderbody sliderbottom slidergrip} {
			foreach hov {{} _hover _pressed _disabled} {
				typecomponent ${orientation}_${pic}image${hov}
			}
		}
		typecomponent ${orientation}_troughsrcimage

		typevariable ${orientation}_arrow1width
		typevariable ${orientation}_arrow1height
		typevariable ${orientation}_arrow2width
		typevariable ${orientation}_arrow2height
	}

	foreach pic {arrow1 arrow2 slidertop sliderbody sliderbottom slidergrip slider} {
		foreach hov {{} _hover _pressed _disabled} {
			component ${pic}image${hov}
		}
	}
	component troughsrcimage
	component troughimage

	variable arrow1width
	variable arrow1height
	variable arrow2width
	variable arrow2height

	variable canvas
	variable visible 1
	variable first 0
	variable last 1
	variable newsize 1
	variable active_element ""
	variable hidden 0
	variable greyed 0
	variable packinfo ""
	variable packlist {}

	option -activebackground -default #ffffff
	option -background -default #eae7e4
	option -bg -default #eae7e4
	option -borderwidth -default 0
	option -bd -default 0
	option -cursor -default {}
	option -highlightbackground -default #eae7e4
	option -highlightcolor -default black
	option -highlightthickness -default 0
	option -jump -default 0
	option -orient -default "vertical" -readonly yes
	option -relief -default sunken
	option -repeatdelay -default 300
	option -repeatinterval -default 100
	option -takefocus -default {}
	option -troughcolor -default #d3d0ce

	option -activerelief -default raised
	option -command -default {}
	option -elementborderwidth -default -1
	option -width -default 14 -configuremethod SetWidth
	option -height -default 200 -configuremethod SetHeight
	
	option -autohide -default 0 -configuremethod ChangeHide

	typeconstructor {
		reloadimages "" 1
	}

	constructor {args} {
		installhull using canvas -bg white -bd 0 -highlightthickness 0
		set canvas $hull

		$self configurelist $args

		#add abbreviations
		if { ($options(-orient) == "v") || ($options(-orient) == "vert") } {
			set options(-orient) "vertical"
		}

		if { $options(-orient) == "vertical" } {
			set orientation "vertical"
		} else {
			set orientation "horizontal"
		}

		foreach pic {arrow1 arrow2 slidertop sliderbody sliderbottom slidergrip} {
			foreach hov {{} _hover _pressed _disabled} {
				set ${pic}image${hov} [set ${orientation}_${pic}image${hov}]
			}
		}
		set troughsrcimage [set ${orientation}_troughsrcimage]

		set arrow1width [set ${orientation}_arrow1width]
		set arrow1height [set ${orientation}_arrow1height]
		set arrow2width [set ${orientation}_arrow2width]
		set arrow2height [set ${orientation}_arrow2height]

		set troughimage [image create photo ${self}through]
		set sliderimage [image create photo ${self}slider]
		set sliderimage_hover [image create photo ${self}slidhov]
		set sliderimage_pressed [image create photo ${self}slidpres]
		set sliderimage_disabled [image create photo ${self}sliddisab]

		$canvas create image 0 0 -anchor nw -image $troughimage -tag $troughimage
		$canvas create image 0 0 -anchor nw -image $sliderimage -activeimage $sliderimage_hover -disabledimage $sliderimage_disabled -tag $sliderimage
		$canvas create image 0 0 -anchor nw -image $arrow1image -activeimage $arrow1image_hover -disabledimage $arrow1image_disabled -tag $arrow1image

		if { $options(-orient) == "vertical" } {
			$canvas create image 0 $newsize -anchor sw -image $arrow2image -activeimage $arrow2image_hover -disabledimage $arrow2image_disabled -tag $arrow2image
		} else {
			$canvas create image $newsize 0 -anchor ne -image $arrow2image -activeimage $arrow2image_hover -disabledimage $arrow2image_disabled -tag $arrow2image
		}

		# Set width / height
		if { $options(-orient) == "vertical" } {
			$self configure -width $arrow1width
		} else {
			$self configure -width $arrow1height
		}

		# Set configure bindings:
		if { $options(-orient) == "vertical" } {
			bind $self <Configure> {
				%W Setnewsize %h
				%W DrawScrollbar
			}
		} else {
			bind $self <Configure> {
				%W Setnewsize %w
				%W DrawScrollbar
			}
		}

		bindtags $self "Pixmapscroll $self all"
		
		bind $self <Button-1> "$self PressedImage %x %y"
		bind $self <ButtonRelease-1> "$self ReleasedImage %x %y"
		
		lappend scrollbarlist $self
	}

	destructor {
		set ndx [lsearch $scrollbarlist $self]

		if {$ndx != -1} {
			set scrollbarlist [lreplace $scrollbarlist $ndx $ndx]
		}
		image delete ${self}through
		image delete ${self}slider
		image delete ${self}slidhov
		image delete ${self}slidpres
		image delete ${self}sliddisab
	}

	method Setnewsize { news } {
		set newsize $news
	}

	method SetWidth {option value} {
		set options($option) $value
		if { $options(-orient) == "vertical" } {
			$canvas configure -width $value
		} else {
			$canvas configure -height $value
		}
	}

	method SetHeight {option value} {
		set options($option) $value
		if { $options(-orient) == "vertical" } {
			$canvas configure -height $value
		} else {
			$canvas configure -width $value
		}
	}

	method ChangeHide {option value} {
		set options($option) $value
		$self HideUnhide
	}

	method Hide { } {
		if { ![catch { set packinfo [pack info $self] }] } {
			set packlist [pack slaves [winfo parent $self]]
			set packlist [lrange $packlist [expr {[lsearch $packlist $self] + 1}] end]
			pack forget $self
			set hidden 1
		}	
	}

	method UnHide {} {
		#only pack if isn't currently packed
		if { [catch { pack info $self }] } {
			foreach child $packlist {
				if { ![catch { pack info $child } ] } {
					append packinfo " -before $child"
					break
				}
			}
			eval pack $self $packinfo
		}
		
		set hidden 0
	}

	method Grey { } {
		#$self ChangePalette 32 2
		$self SetState disabled
		set greyed 1
		#bind $self <Button-1> ""
		#bind $self <ButtonRelease-1> ""
	}

	method UnGrey { } {
		#$self ChangePalette 256/256/256 1
		$self SetState normal
		set greyed 0
		#bind $self <Button-1> "$self PressedImage %x %y"
		#bind $self <ButtonRelease-1> "$self ReleasedImage %x %y"
	}

	method SetState { value } {
		$canvas configure -state $value
	}
	
#	method ChangePalette { palette gamma } {
#		
#		foreach pic {arrow1 arrow2 slidertop sliderbody sliderbottom slidergrip slider} {
#			foreach hov {{} _hover _pressed _disabled} {
#				catch {[set ${pic}image${hov}] configure -palette $palette -gamma $gamma} res
#			}
#		}
#		catch { $troughsrcimage configure -palette $palette -gamma $gamma}
#		catch { $troughimage configure -palette $palette -gamma $gamma}
#	}

	method HideUnhide { } {
			# hide it or grey it out
		if { $visible == 1} {
			if {$options(-autohide)} {
				# Hide it
				if {$hidden == 0} {
					$self Hide
				}
			} else {
				# grey it
				if {$hidden == 1 } {
					# Unhide it first
					$self UnHide
				}
				if {$greyed == 0 } {
					$self Grey
				}
			}

		} else {
			# Unhide or ungrey
			if { $hidden == 1 } {
				$self UnHide
			}
		
			if { $greyed == 1 } {
				$self UnGrey
			}
	
		}
	}

	method PressedImage { x y } {
		set element [$self identify $x $y]
		switch $element {
			"slider" { $canvas itemconfigure $sliderimage -image $sliderimage_pressed -activeimage $sliderimage_pressed }
			"arrow1" { $canvas itemconfigure $arrow1image -image $arrow1image_pressed -activeimage $arrow1image_pressed }
			"arrow2" { $canvas itemconfigure $arrow2image -image $arrow2image_pressed -activeimage $arrow2image_pressed }
			default { return }
		}
	}
	
	method ReleasedImage { x y } {
		$canvas itemconfigure $sliderimage -image $sliderimage -activeimage $sliderimage_hover
		$canvas itemconfigure $arrow1image -image $arrow1image -activeimage $arrow1image_hover
		$canvas itemconfigure $arrow2image -image $arrow2image -activeimage $arrow2image_hover
	}

	#Draw or redraw the scrollbar
	method DrawScrollbar { } {
		#Drawing Arrows:
		if { $options(-orient) == "vertical" } {
			$canvas coords $arrow2image 0 $newsize
		} else {
			$canvas coords $arrow2image $newsize 0
		}

		#Drawing Trough
		if { $options(-orient) == "vertical" } {
			$troughimage blank
			$troughimage copy $troughsrcimage -to 0 0 [image width $troughsrcimage] $newsize
		} else {
			$troughimage blank
			$troughimage copy $troughsrcimage -to 0 0 $newsize [image height $troughsrcimage]
		}

		#Drawing Slider
		if { $options(-orient) == "vertical" } {
			set slidersize [lindex [split [expr {$visible * ($newsize - ($arrow1height + $arrow2height))}] .] 0]

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


			set gripPos [expr {($slidersize/2) - ([image height $slidergripimage]/2)}]
			if {$gripPos < 0} {set gripPos 1}


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


			$sliderimage_hover blank
			$sliderimage_hover copy $slidertopimage_hover
			$sliderimage_hover copy $sliderbodyimage_hover -to 0 [image height $slidertopimage_hover] [image width $sliderbodyimage_hover] [expr {$slidersize - [image height $sliderbottomimage_hover] }]
			$sliderimage_hover copy $sliderbottomimage_hover -to 0 [expr {$slidersize - [image height $sliderbottomimage_hover]}] -shrink
			if  {[expr {$slidersize - [image height $sliderbottomimage_hover] }] >= [image height $slidergripimage_hover]} {
				$sliderimage_hover copy $slidergripimage_hover -to 0 $gripPos
			}
			
			$sliderimage_pressed blank
			$sliderimage_pressed copy $slidertopimage_pressed
			$sliderimage_pressed copy $sliderbodyimage_pressed -to 0 [image height $slidertopimage_pressed] [image width $sliderbodyimage_pressed] [expr {$slidersize - [image height $sliderbottomimage_pressed] }]
			$sliderimage_pressed copy $sliderbottomimage_pressed -to 0 [expr {$slidersize - [image height $sliderbottomimage_pressed]}] -shrink
			if  {[expr {$slidersize - [image height $sliderbottomimage_pressed] }] >= [image height $slidergripimage_pressed]} {
				$sliderimage_pressed copy $slidergripimage_pressed -to 0 $gripPos
			}
			
			$sliderimage_disabled blank
			$sliderimage_disabled copy $slidertopimage_disabled
			$sliderimage_disabled copy $sliderbodyimage_disabled -to 0 [image height $slidertopimage_disabled] [image width $sliderbodyimage_disabled] [expr {$slidersize - [image height $sliderbottomimage_disabled] }]
			$sliderimage_disabled copy $sliderbottomimage_disabled -to 0 [expr {$slidersize - [image height $sliderbottomimage_disabled]}] -shrink
			if  {[expr {$slidersize - [image height $sliderbottomimage_disabled] }] >= [image height $slidergripimage_disabled]} {
				$sliderimage_disabled copy $slidergripimage_disabled -to 0 $gripPos