Updated 2016-07-06 18:41:39 by JayBy

JayBy 2016-07-06

For my dartscript, I use labels outside of a frame. Here is an extended version. I wrote this especially for scrolledframes. With a scrolledframe the header row and index column can scroll with the scrolled body.

If used with a scrolledframe, the head and index frames have to be also a scrolledframe. It's written for scrolledframe 0.9.1 (KJN optimized & enhanced version).

The procedures for head row / index column in gridLabels.tcl:
#******************************************************************************
#           GridLabels
#
# Procedures for creating labels outside a gridded scrolledframe:
#   (used with scrolledframe 0.9.1 (KJN optimized & enhanced version))
#
# $HF = Path of (inner) head frame
# $IF = Path of (inner) index frame
# $BF = Path of (inner) body frame
# Head labels = ${HF}.head0, ${HF}.head1, ...
# Index labels = ${HF}.index0, ${HF}.index1, ...

#------------------------------------------------------------------------------
#           Scrolled Frame
#

#--- GridHead ----------------------------------------------
# Configure (scrollable) head frame
#   - Create head labels, if necessary
#   - Place head labels
#   - Scrolls head frame, if it's a scrolledframe
# Args: Inner HeadFrame, inner BodyFrame, ?-scroll <Bool>?
#   -scroll = Is headframe a scrolledframe or not?

proc gridHead {HF BF args} {
    set H 0
    # $HF is scrollable ?
    if {[regexp -- {.scrolled$} $HF]} {
        set S "true"
    } else {
        set S "false"
    }
    foreach {O V} $args {
        if {$O == "-scroll"} {
            set S $V
        }
    }
    # How many Cols ?
    lassign [grid size $BF] Cols Rows
    #--- Configure head labels
    for {set c 0} {$c < $Cols} {incr c} {
        # Create Head<Nr>, if not exists
        if {[winfo exists ${HF}.head$c] == 0} {
            ttk::label ${HF}.head$c -text "Head $c" -style Grid.TLabel -anchor c
        }
        # Set Width + Pos
        lassign [grid bbox $BF $c 0] x y w h
        place ${HF}.head$c -x $x -y 0 -width $w
        # Set Height
        set h [winfo reqheight ${HF}.head$c]
        if {$h > $H} {set H $h}
    }
    #--- Configure height
    # Uniform height of heads
    foreach l [winfo children $HF] {
        place configure $l -height $H
    }
    # Create height of (outer) frame
    $HF configure -height $H
    if {[string is true $S]} {
        [winfo parent $HF] configure -height $H
        #--- Scroll position
        set w [winfo width [winfo parent $BF]]
        set x [winfo x $BF]
        place $HF -x [expr $x + 1] -width [expr [string trim $x -] + $w]
    }
}

#--- GridIndex ---------------------------------------------
# Configure (scrollable) index frame
#   - Create index labels, if necessary
#   - Place index labels
#   - Scrolls index frame, if it's a scrolledframe
# Args: Inner IndexFrame, inner BodyFrame, ?-scroll <Bool>?
#   -scroll = Is indexframe a scrolledframe or not?

proc gridIndex {IF BF args} {
    set W 0
    # $IF is scrollable ?
    if {[regexp -- {.scrolled$} $IF]} {
        set S "true"
    } else {
        set S "false"
    }
    foreach {O V} $args {
        if {$O == "-scroll"} {
            set S $V
        }
    }
    # How many Rows ?
    lassign [grid size $BF] Cols Rows
    #--- Configure index labels
    for {set r 0} {$r < $Rows} {incr r} {
        # Create Index<Nr>, if not exists
        if {[winfo exists ${IF}.index$r] == 0} {
            ttk::label ${IF}.index$r -text "Idx $r" -style Grid.TLabel -anchor c
        }
        # Set Height + Pos
        lassign [grid bbox $BF 0 $r] x y w h
        place ${IF}.index$r -x 0 -y $y -height $h
        # Set Width
        set w [winfo reqwidth ${IF}.index$r]
        if {$w > $W} {set W $w}
    }
    #--- Configure width
    # Uniform width of index
    foreach l [winfo children $IF] {
        place configure $l -width $W
    }
    # Create width of (outer) frame
    $IF configure -width $W
    if {[string is true $S]} {
        [winfo parent $IF] configure -width $W
        #--- Scroll position
        set h [winfo height [winfo parent $BF]]
        set y [winfo y $BF]
        place $IF -y [expr $y + 1] -height [expr [string trim $y -] + $h]
    }
}

A demo script:
#******************************************************************************
#           Gridded Scroll Demo
#
# Demonstrate usage of gridLabels in a scrolled frame.
#   Using scrolledframe 0.9.1 (The KJN optimized & enhanced version)
#

lappend auto_path [file normalize [file join [file dirname [info script]] .. lib]]

package require Tk
package require scrolledframe

source [file join [file dirname [info script]] gridLabels.tcl]

#------------------------------------------------------------------------------
#       Main
#

wm geometry . 600x400

#--- Head Frame --------------------------------------------

# Outer frame
set HeadFrame0  [scrolledframe::scrolledframe .headframe \
                -fill both \
                ]
# Inner frame
set HeadFrame   ${HeadFrame0}.scrolled

#--- Index Frame -------------------------------------------

# Outer frame
set IndexFrame0 [scrolledframe::scrolledframe .indexframe \
                -fill both\
                ]
# Inner frame
set IndexFrame  ${IndexFrame0}.scrolled

#--- BodyFrame ---------------------------------------------

set BodyFrame0  [scrolledframe::scrolledframe .bodyframe \
                -yscrollcommand ".vscroll set" \
                -xscrollcommand ".hscroll set" \
                -fill both \
                ]
set BodyFrame   ${BodyFrame0}.scrolled
set VScroll     [ttk::scrollbar .vscroll -command "$BodyFrame0 yview"]
set HScroll     [ttk::scrollbar .hscroll -command "$BodyFrame0 xview" \
                -orient horizontal]
# Gridded layout
for {set r 0} {$r < 10} {incr r} {
    for {set c 0} {$c < 10} {incr c} {
        set Cell($r,$c) [ttk::frame ${BodyFrame}.cell-$r-$c -padding 10 -relief sunken]
        set Label($r,$c) [ttk::label $Cell($r,$c).label-$r-$c -text "Label $r/$c"]
        set Entry($r,$c) [ttk::entry $Cell($r,$c).entry-$r-$c -width 10 -justify c]
        $Entry($r,$c) insert 0 "Value $r/$c"
        grid $Cell($r,$c) -column $c -row $r -sticky nswe
        pack $Label($r,$c) -anchor w
        pack $Entry($r,$c)
    }
}

#--- Configure ---------------------------------------------

ttk::style configure Grid.TLabel -borderwidth 1 -relief raised -padding 2

grid $HeadFrame0 -column 1 -row 0 -sticky nswe
grid $IndexFrame0 -column 0 -row 1 -sticky nswe
grid $BodyFrame0 -column 1 -row 1 -sticky nswe
grid $VScroll -column 2 -row 1 -sticky ns
grid $HScroll -column 1 -row 2 -sticky we

grid columnconfigure $HeadFrame all -weight 1
grid rowconfigure $IndexFrame all -weight 1
grid columnconfigure $BodyFrame0 all -weight 1
grid columnconfigure $BodyFrame all -weight 1
grid rowconfigure $BodyFrame0 all -weight 1
grid rowconfigure $BodyFrame all -weight 1
grid columnconfigure . 1 -weight 1
grid rowconfigure . 1 -weight 1

#--- Bind procs (with inner scrollable frames) -------------

bind . <Configure>  {+   gridHead $HeadFrame $BodyFrame
                        gridIndex $IndexFrame $BodyFrame
                    }