**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 but the vista native style.
======
. 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 
        puts bfh-$buttonFrameHeight
        incr fontSize $increment
        font configure entryFont -size $fontSize
        update idletasks
        set imageSize [expr {[winfo reqheight .e] - $buttonFrameHeight}]
        puts isu-$imageSize
        set padSize [expr {$imageSize / 8} ]
        set padSize 0
        i configure -width $imageSize -height $imageSize
        arrowimage i top $padSize $padSize
        .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}]
    }
}
======


<<categories>>Widget