font create font_of_metro_button -family {Segoe UI} -size 13
proc text_metrics {font text {w ""}} {
for {set i 1} {[winfo exists $w.label-$i]} {incr i} {}
set l $w.label-$i
label $l -bd 0 -padx 0 -pady 0 -highlightthickness 0 -font $font -text $text
set width [winfo reqwidth $l]
set height [winfo reqheight $l]
destroy $l
return [list $width $height]
}
proc active_button {parent text} {
return [metro_button $parent $text \
-font_color white \
-font_color_hover white \
-shadow_color grey40 \
-offset_shadow 2 \
-outline #59cde2 \
-outline_hover #75c7ee \
-borderwidth 1 \
-ipadx 22 \
-ipady 11 \
-font font_of_metro_button \
-background #1ba1e2 \
-background_hover #75c7ee]
}
proc inactive_button {parent text} {
return [metro_button $parent $text \
-font_color black \
-font_color_hover white \
-offset_shadow 2 \
-outline #eeeeee \
-outline_hover #75c7ee \
-borderwidth 2 \
-ipadx 22 \
-ipady 11 \
-font font_of_metro_button \
-background white \
-background_hover #75c7ee]
}
proc metro_button {parent text args} {
array set option $args
lassign [text_metrics $option(-font) 1] text_width text_height
set width [expr $text_width + 2*$option(-offset_shadow) + $option(-ipadx)]
set height [expr $text_height + 2*$option(-offset_shadow) + $option(-ipady)]
set c [canvas $parent.[info cmdcount] -bd 0 -highlightthickness 0 -width $width -height $height]
set list_of_items [list]
set rectangle [$c create rectangle 0 0 [expr $width-1] [expr $height-1] -width $option(-borderwidth) -outline $option(-outline) -fill $option(-background)]
lappend list_of_items $rectangle
set x0 [expr $width/2]
set y0 [expr $height/2]
if {[info exists option(-shadow_color)]} {
set x1 [expr {$x0 + $option(-offset_shadow)}]
set y1 [expr {$y0 + $option(-offset_shadow)}]
set shadow_item [$c create text $x1 $y1 -text $text -font $option(-font) \
-anchor center -fill $option(-shadow_color)]
lappend list_of_items $shadow_item
}
set text_item [$c create text $x0 $y0 -text $text -font $option(-font) \
-anchor center -fill $option(-font_color)]
lappend list_of_items $text_item
foreach w $list_of_items {
$c bind $w <Enter> [list apply {{c rectangle text_item background_hover outline_hover font_color_hover} {
$c itemconfig $rectangle -fill $background_hover -outline $outline_hover
$c itemconfig $text_item -fill $font_color_hover
}} $c $rectangle $text_item $option(-background_hover) $option(-outline_hover) $option(-font_color_hover)]
$c bind $w <Leave> [list apply {{c rectangle text_item background outline font_color} {
$c itemconfig $rectangle -fill $background -outline $outline
$c itemconfig $text_item -fill $font_color
}} $c $rectangle $text_item $option(-background) $option(-outline) $option(-font_color)]
if {[info exists option(-command)] && $option(-command) ne ""} {
$c bind $w <1> +$option(-command)
}
}
return $c
}
wm geometry . 200x200
pack [inactive_button . 1] -side left -padx 4
pack [active_button . 2] -side left -padx 4
pack [inactive_button . 3] -side left -padx 4
pack [inactive_button . 4] -side left -padx 4