Metro style buttons

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