create triangle image

Create triangle image dynamically

HaO 2010-11-25: On a image create photo, a triangle of various dimensions may be painted on demand. The aim is to replace the BWidget ArrowButton by a ttk::button and a dynamically generated image.

The triangle is painted with the given foreground color on transparent background.

Examples

Simple

image create photo i -width 30 -height 30
arrowimage i right
pack [ttk::button .l -image i -style Toolbutton]

created triangle image sample

Dynamic

Change the size of a toolbutton with the size of a font and over theme changes. The following example should arrange, that the ttk::combobox and ttk::button should have equal height only by resizing the image of the button. Thus, the red background should never show up. For me, this works on windows vista for all styles.

For real applications, the images should be packed with -fill y to avoid eventual gaps.

A test image of a fix size of 30x30 is used to measure the extend added by the button widget. The size is chosen this large to avoid inner padding.

The triangle color is taken from the button foreground of the current style. Anyway, this is always black in the standard styles.

. configure -bg red
set fontSize 12
font create entryFont -size $fontSize
pack [ttk::combobox .e -font entryFont -values [ttk::style theme names]\
        -state readonly] -side left
.e set [ttk::style theme use]
bind .e <<ComboboxSelected>> {ttk::style theme use [.e get]}

image create photo i -width 16 -height 16
pack [ttk::button .b -image i -style Toolbutton -command [list setFont 1]] -side right
bind .b <<ThemeChanged>> setFont
proc setFont {{increment 0}} {
    global fontSize
    image create photo itest -width 30 -height 30
    ttk::button .btest -image itest -style Toolbutton
    set buttonFrameHeight [expr {[winfo reqheight .btest] - 30}]
    destroy .btest
    image delete itest 
    incr fontSize $increment
    font configure entryFont -size $fontSize
    update idletasks
    set imageSize [expr {[winfo reqheight .e] - $buttonFrameHeight}]
    set padSize [expr {$imageSize / 8} ]
    i configure -width $imageSize -height $imageSize
    arrowimage i top $padSize $padSize\
            [format #%02x%02x%02x {*}[winfo rgb .\
            [::ttk::style lookup TButton -foreground]]]
    .b configure -image i
}
setFont

Invocation

arrowimage

photoCmd	The command name of an image, as given to the image create photo command
dir	Direction of the arrow. One of top,right, bottom or left
ipadx	Empty pixels around the image on the left and right of the image
ipady	Empty pixels around the image on the top and bottom of the image
foreground	The foreground color of the arrow

ToDo

Antialiasing
For some applications, a triangle with the long bar in image center would be nicer. This is easy to acheve with an additional parameter.

Code

proc arrowimage { photoCmd dir {ipadx 0} {ipady 0} {foreground black} } {
    
    set width [$photoCmd cget -width]
    set height [$photoCmd cget -height]
    set w [expr {$width  - 2*$ipadx}]
    set h [expr {$height - 2*$ipady}]

    set x0 [expr {($width-$w)/2}]
    set y0 [expr {($height-$h)/2}]
    set x1 [expr {$x0+$w-1}]
    set y1 [expr {$y0+$h-1}]
    # > Make the frame transparent and the inside with a square
    for {set y 0} {$y < $y0} {incr y} {
        for {set x 0} {$x < $height} {incr x} {
            $photoCmd transparency set $x $y 1
        }
    }
    for {set y [expr {$y1+1}]} {$y < $height} {incr y} {
        for {set x 0} {$x < $height} {incr x} {
            $photoCmd transparency set $x $y 1
        }
    }
    for {set y $y0} {$y <= $y1} {incr y} {
        for {set x 0} {$x < $x0} {incr x} {
            $photoCmd transparency set $x $y 1
        }
    }
    for {set y $y0} {$y <= $y1} {incr y} {
        for {set x [expr {$x1+1}]} {$x < $width} {incr x} {
            $photoCmd transparency set $x $y 1
        }
    }
    $photoCmd put $foreground -to $x0 $y0 [expr {$x1+1}] [expr {$y1+1}]
    # > Paint triangles as transparency
    switch $dir {
        top - bottom {
            set h0 $x0
            set h1 $x1
            set v0 $y0
            set v1 $y1
            # > On even size move right limit one to right
            set e1 [expr {($w % 2 == 0)?1:0}]
            set fHorX 1
        }
        default {
            set h0 $y0
            set h1 $y1
            set v0 $x0
            set v1 $x1
            set e1 [expr {($h % 2 == 0)?1:0}]
            set fHorX 0
        }
    }
    switch $dir {
        top - left {
            set corVert $v0
            set DCorVert 1
        }
        default {
            set corVert $v1
            set DCorVert -1
        }
    }
    set m [expr {($h0+$h1)/2}]
    set DHor [expr {$h1 - $m}]
    set DVert [expr {$v1 - $v0}]
    set d 0
    set r 0
    for {set vertLoop 0} {$vertLoop < $DVert} {incr vertLoop} {
        set limitHor [expr {$m - $d}]
        for {set horLoop 0} {$horLoop < $limitHor} {incr horLoop} {
            $photoCmd transparency set\
                    [expr {$fHorX?$horLoop:$corVert}]\
                    [expr {$fHorX?$corVert:$horLoop}] 1
        }
        set limitHor [expr {$m + $d + 1 + $e1}]
        for {set horLoop $limitHor} {$horLoop <= $h1} {incr horLoop} {
            $photoCmd transparency set\
                    [expr {$fHorX?$horLoop:$corVert}]\
                    [expr {$fHorX?$corVert:$horLoop}] 1
        }
        incr corVert $DCorVert
        incr r $DHor
        incr d [expr { $r / $DVert } ]
        set r [expr { $r % $DVert}]
    }
}

Category Widget