pixmapmenu.tcl

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

		set id [eval $self CreateEntry $index $_type $args]
		# Insert the entry in the list of entries
		set entries [linsert $entries $index $id]
	}

	method delete { index {index2 {}} } {
		if { $index2 == "" } {
			set index2 $index
		}
		set nindex [$self index $index]
		set nindex2 [$self index $index2]
		if { $nindex == "none" || $nindex2 == "none" } {
			return
		}
		foreach entry [lrange $entries $nindex $nindex2] {
			contentmanager delete $main $entry
			$config($entry) destroy
			foreach tag [$canvas find withtag entry$entry] {
				$canvas delete $tag
			}
		}
		set entries [concat [lrange $entries 0 [expr {$nindex - 1}]] [lrange $entries [expr {$nindex2 + 1}] end]]
		$self sort
		$self UpdateSize
	}

	method entryconfigure { index args } {
		set nindex [$self index $index]
		if { $nindex == "none" } {
			return
		}
		set entry [lindex $entries $nindex]
		$config($entry) configurelist $args
	}

	method entrycget { index option } {
		set nindex [$self index $index]
		if { $nindex == "none" } {
			return
		}
		set entry [lindex $entries $nindex]
		return [$config($entry) cget $option]
	}

	method index { index } {
		# Given index as an integer
		if { [string is integer $index] } {
			if { $index >= 0 && $index <= [$self index last] } {
				return $index
			} else {
				return "none"
			}
		}

		# Given index in the form @x,y
		if { [string index $index 0] == "@" } {
			set index [string map {@ "" , " "} $index]
			return [eval $self EntryAtPoint $index]
		}

		# Given index as "start" or "end" or "last" or "none" or "active"
		switch $index {
			start {	return 0 }
			end { 	return [expr {[llength $entries] - 1}] }
			last { 	return [expr {[llength $entries] - 1}] }
			active {
				if { $active != "" } {
					return $active
				} else {
					return "none"
				}
			}
			none {	return "none" }
		}

		# Search by pattern
		foreach entry $entries {
			set i [lsearch $entries $entry]
			if { [$self type $i] == "separator" } {
				continue
			}	
			set label [$self entrycget $i -label]
			if { [string match $index $label] } {
				return $i
			}
		}

		# If all else fails...
		return "none"
	}

	method invoke { index } {
		set nindex [$self index $index]
		if { $nindex == "none" || [$self entrycget $nindex -state] == "disabled" || [$self type $nindex] == "separator" } {
			return
		}
		set entry [lindex $entries $nindex]
		set _type [$config($entry) type]
		if { $_type == "checkbutton" } {
			$config($entry) toggle
			if { [$canvas itemcget $checktickid($entry) -state] == "hidden" && [$config($entry) cget -indicatoron] } {
				$canvas itemconfigure $checktickid($entry) -state normal
			} else {
				$canvas itemconfigure $checktickid($entry) -state hidden
			}
		} elseif { $_type == "radiobutton" } {
			$config($entry) select
			if { [$canvas itemcget $radiotickid($entry) -state] == "hidden" && [$config($entry) cget -indicatoron] } {
				$canvas itemconfigure $radiotickid($entry) -state normal
			}
		}
		eval [$config($entry) cget -command]
	}

	method EntryAtPoint { x y } {
		set id none
		foreach entry $entries {
			set coords 	[contentmanager	getcoords	$main	$entry]
			set width 	[contentmanager	width		$main	$entry]
			set height 	[contentmanager	height		$main	$entry]

			switch $options(-orient) {
				horizontal {
					set x0 [lindex $coords 0]
					set x1 [expr {$x0 + $width}]
					set y0 $options(-ipady)
					set y1 [expr {[winfo height $self] - $options(-ipady)}]
				}
				vertical {
					set x0 $options(-ipadx)
					set x1 [expr {[winfo width $self] - $options(-ipadx)}]
					set y0 [lindex $coords 1]
					set y1 [expr {$y0 + $height}]
				}
			}

			if { $x >= $x0 && $x <= $x1 && $y >= $y0 && $y <= $y1 } {
				set id $entry
				break
			}
		}

		if { $id == "none" } {
			return "none"
		} else {
			return [lsearch $entries $id]
		}
	}

	method activate { index {b 0} } {
		# Don't bother activating an entry that's already active
		if { $index == $active && $b == 0 } {
			return
		}
		# Return the previously activated entry's state to normal
		if { $active != "none" } {
			$self EntryConfigureState [lindex $entries $active] normal
		}

		set nindex [$self index $index]
		# Don't activate separators or disabled entries, hide the select image
		if { $nindex == "none" || [$self entrycget $index -state] == "disabled" || [$self type $index] == "separator" } {
			set active "none"
			$canvas itemconfigure $selectid -state hidden
			return
		}

		# Work out coords dimensions for select image
		set entry [lindex $entries $nindex]
		set coords [contentmanager getcoords $main $entry]
		switch $options(-orient) {
			horizontal {
				set width [contentmanager width $main $entry]
				set height [expr {[winfo height $self] - (2 * $options(-ipady))}]
			}
			vertical {
				set width [expr {[winfo width $self] - (2 * $options(-ipadx))}]
				set height [contentmanager height $main $entry]
			}
		}

		# Configure the select image with those dimensions and place it at those coords
		$select configure -width $width -height $height
		eval $canvas coords $selectid $coords
		$canvas itemconfigure $selectid -state normal

		# Make the now-active entry's state active
		$self EntryConfigureState [lindex $entries $nindex] active
		# Store it as the active entry
		set active $nindex

		# Do we want to post the submenu (if entry is cascade) or not (yes when using mouse, no when using keyboard arrows)
		if { $b == 1 && [$self type $nindex] == "cascade" } {
			$self postcascade $nindex
		}
	}

	method postcascade { index } {
		set nindex [$self index $index]
		# If the submenu is already posted, don't bother
		if { [$self type $nindex] == "cascade" } {
			if { [winfo ismapped [$self entrycget $nindex -menu]] } {
				return
			}
		}
		# Unpost any posted cascades in this menu
		foreach entry $entries {
			if { [$self type [lsearch $entries $entry]] == "cascade" } {
				set menu [$self entrycget [lsearch $entries $entry] -menu]
				if { $menu != "" } {
					$menu unpost
				}
			}
		}
		# Can't postcasade "none" or a non-cascade/disabled entry
		if { $nindex == "none" || [$self type $nindex] != "cascade" || [$self entrycget $nindex -state] == "disabled" } {
			return
		}
		set entry [lindex $entries $nindex]
		set menu [$self entrycget $nindex -menu]
		# Set coords to post submenu at
		switch $options(-orient) {
			horizontal {
				set x [expr {[winfo rootx $self] + [$self xposition $nindex]}]
				set y [expr {[winfo rooty $self] + [winfo height $self]}]
				# Make sure we post it in-screen
				if { [expr {$x + [$menu cget -width]}] > [winfo screenwidth $self] } {
					incr x -[$menu cget -width]
					incr x [contentmanager width $main $entry]
				}
				if { [expr {$y + [$menu cget -height]}] > [winfo screenheight $self] } {
					incr y -[$menu cget -height]
					incr y [winfo height $self]
				}
			}
			vertical {
				set x [expr {[winfo rootx $self] + [winfo width $self] - $options(-entrypadx)}]
				set y [expr {[winfo rooty $self] + [$self yposition $nindex]}]
				# Make sure we post it in-screen
				if { [expr {$x + [$menu cget -width]}] > [winfo screenwidth $self] } {
					incr x -[$menu cget -width]
					incr x -[winfo width $self]
					incr x [expr {2 * $options(-entrypadx)}]
				}
				if { [expr {$y + [$menu cget -height]}] > [winfo screenheight $self] } {
					incr y -[$menu cget -height]
					incr y [contentmanager height $main $entry]
				}
			}
		}
		# And, finally, post it :)
		$menu post $x $y
	}

	method type { index } {
		set nindex [$self index $index]
		if { $nindex == "none" } {
			return
		}
		set entry [lindex $entries $nindex]
		return [$config($entry) type]
	}

	method xposition { index } {
		set nindex [$self index $index]
		if { $nindex == "none" } {
			return
		}
		set entry [lindex $entries $nindex]
		return [lindex [contentmanager getcoords $main $entry] 0]
	}

	method yposition { index } {
		set nindex [$self index $index]
		if { $nindex == "none" } {
			return
		}
		set entry [lindex $entries $nindex]
		return [lindex [contentmanager getcoords $main $entry] 1]
	}

	method sort { } {
		after cancel $afterid(Sort)
		set afterid(Sort) [after 1 "$self Sort"]
	}

	method Sort { } {
		contentmanager sort $main
		$self UpdateSize
		$self AlignCascadeArrows
	}

	method SetOrient { option value } {
		set options(-orient) $value
		switch $value {
			horizontal {
				#set arrowimg [::skin::loadPixmap menuarrowdown]
			}
			vertical {
				#set arrowimg [::skin::loadPixmap menuarrowright]
			}
		}
	}

	method SetPadding { option value } {
		set options($option) $value
		contentmanager configure $main -ipadx $options(-ipadx) -ipady $options(-ipady)
		foreach entry $entries {
			contentmanager configure $main $entry -ipadx $options(-entrypadx) -ipady $options(-entrypady)
			contentmanager configure $main $entry icon -padx $options(-entrypadx) -pady $options(-entrypady)
			contentmanager configure $main $entry text -padx $options(-entrypadx) -pady $options(-entrypady)
		}
		$self Sort
	}

	method SetFont { option value } {
		set options(-font) $value
		foreach entry $entries {
			if { [$self type [lsearch $entries $entry]] != "separator" } {
				$self EntryConfigureFont $entry $value
			}
		}
	}

	method SetForeground { option value } {
		switch [string index $option 1] {
			a {
				set options(-activeforeground) $value
				set options(-activefg) $value
				foreach entry $entries {
					if { [$self type [lsearch $entries $entry]] != "separator"  && [$self entrycget $index -state] == "active"} {
						$self EntryConfigureForeground $entry $value
					}
				}
			}
			d {
				set options(-disabledforeground) $value
				set options(-disabledfg) $value
				foreach entry $entries {
					set index [lsearch $entries $entry]
					if { [$self type $index] != "separator" && [$self entrycget $index -state] == "disabled"} {
						$self EntryConfigureForeground $entry $value
					}
				}
			}
			f {
				set options(-foreground) $value
				set options(-fg) $value
				foreach entry $entries {
					if { [$self type [lsearch $entries $entry]] != "separator" && [$self entrycget $index -state] == "normal" } {
						$self EntryConfigureForeground $entry $value
					}
				}
			}
		}
	}

	method EntryConfigureFont { id value } {
		$canvas itemconfigure $textid($id) -font $value
		$self sort
	}

	method EntryConfigureForeground { id value } {
		$canvas itemconfigure $textid($id) -fill $value
	}

	method EntryConfigureIndicator { id value } {
			switch [$config($id) type] {
				"checkbutton" {
					if { $value } {
						$canvas itemconfigure $imageid($id) -state normal
						if { [set [$config($id) cget -variable]] == [$config($id) cget -onvalue] } {
							$canvas itemconfigure $checktickid($id) -state normal
						}
					} else {
						$canvas itemconfigure $imageid($id) -state hidden
						$canvas itemconfigure $checktickid($id) -state hidden
					}
				}
				"radiobutton" {
					if { $value } {
						$canvas itemconfigure $imageid($id) -state normal
						if { [set [$config($id) cget -variable]] == [$config($id) cget -value] } {
							$canvas itemconfigure $radiotickid($id) -state normal
						}
					} else {
						$canvas itemconfigure $imageid($id) -state hidden
						$canvas itemconfigure $radiotickid($id) -state hidden
					}
				}
			}
			$self sort
	}

	method EntryConfigureState { id value } {
		switch $value {
			active { $canvas itemconfigure $textid($id) -fill $options(-activeforeground) }
			disabled { $canvas itemconfigure $textid($id) -fill $options(-disabledforeground) }
			normal { $canvas itemconfigure $textid($id) -fill $options(-foreground) }
		}
	}
}