Updated 2016-04-14 06:56:55 by AMG

This is my version of scrolled frame with mouse support. I use TclOO.
oo::class create Scrolling_Area {    
    variable widget_path scrolling_orientation mousewheel_speed inner_frame scrolling_area
    
    constructor {root args} {
        array set opts [list -mousewheel_speed 2 -scroll_horizontally true -scroll_vertically true]
        array set opts $args
        
        if {!$opts(-scroll_horizontally) && !$opts(-scroll_vertically)} {
            return -code error "No direction for scrolling indicated"
        }

        if {![string is digit -strict $opts(-mousewheel_speed)]} {
            return -code error "mousewheel_speed must be an integer."
        }
        
        set mousewheel_speed $opts(-mousewheel_speed)
                
        set scrolling_orientation ""
        
        set widget_path [::ttk::frame $root.widget  -borderwidth 0]
        
        if {$::tcl_platform(os) eq "Linux"} {
            bind all <4> +[namespace code {my OnMouseWheel %b}]
            bind all <5> +[namespace code {my OnMouseWheel %b}]
        } else {
            # Windows and MacOS
            bind all <MouseWheel> +[namespace code {my OnMouseWheel %D}]
        }
        
        set list_of_canvas_properties [list]
            
        # the string '-canvas_' has 8 characters
        foreach {property_name property_value} [array get opts -canvas_*] {
            lappend list_of_canvas_properties -[string range $property_name 8 end] $property_value
        }
            
        set scrolling_area [canvas $widget_path.canvas {*}$list_of_canvas_properties]
        grid $scrolling_area -row 0 -column 0 -sticky news

        grid rowconfigure $widget_path 0 -weight 1
        grid columnconfigure $widget_path 0 -weight 1
        
        set list_of_innerframe_properties [list]
            
        # the string '-innerframe_' has 12 characters
        foreach {property_name property_value} [array get opts -innerframe_*] {
            lappend list_of_innerframe_properties -[string range $property_name 12 end] $property_value
        }
            
        set inner_frame [::ttk::frame $scrolling_area.inner_frame {*}$list_of_innerframe_properties]
        pack $inner_frame
        
        $scrolling_area create window 0 0 -window $inner_frame -anchor nw -tags inner_frame
                    
        bind $scrolling_area <Configure> [namespace code {my Configure_widget}]
        bind $inner_frame <Configure> [namespace code {my Configure_widget}]
        
        
        if $opts(-scroll_vertically) {
            set yscrollbar [::ttk::scrollbar $root.widget.yscrollbar -orient vertical -command [list $scrolling_area yview]]
            
            grid $yscrollbar -row 0 -column 1 -sticky "ns"
        
            $scrolling_area config -yscrollcommand [list $yscrollbar set]
        }
        
        if {$opts(-scroll_horizontally)} {
            set xscrollbar [::ttk::scrollbar $root.widget.xscrollbar -orient horizontal -command [list $scrolling_area xview]]
            grid $xscrollbar -row 1 -column 0 -sticky ew
            
            $scrolling_area config -xscrollcommand [list $xscrollbar set]
        }
        
        if {$opts(-scroll_vertically)} {
            set default_scrolling y
        } else {
            set default_scrolling x
        }
            
        bind $scrolling_area <Enter> [namespace code [list set scrolling_orientation $default_scrolling]]
        bind $scrolling_area <Leave> [namespace code [list set scrolling_orientation ""]]


        foreach orient {x y} {
            if {[info exists ${orient}scrollbar]} {
                set scrollbar_name [set ${orient}scrollbar]
                
                bind $scrollbar_name <Enter> [namespace code [list set scrolling_orientation $orient]]
                bind $scrollbar_name <Leave> [namespace code [list set scrolling_orientation ""]]
            }
        }
    }
    
    method Configure_widget {} {
        set width [expr "max([winfo reqwidth $inner_frame],[winfo width $scrolling_area])"]
        set height [expr "max([winfo reqheight $inner_frame],[winfo height $scrolling_area])"]
        
        $scrolling_area config -scrollregion "0 0 $width $height"
        
        $scrolling_area itemconfigure "inner_frame" -width $width
        $scrolling_area itemconfigure "inner_frame" -height $height
    }
    
    method inner_frame {} {
        return $inner_frame
    }
    
    method pack {args} {
        pack $widget_path {*}$args
    }
    
    method grid {args} {
        grid $widget_path {*}$args
    }
    
    method place {args} {
        place $widget_path {*}$args
    }


}

if {$::tcl_platform(os) eq "Linux"} {
    oo::define Scrolling_Area method OnMouseWheel num {
        if {$scrolling_orientation ne ""} {            
            if {$num == 4} {
                $scrolling_area ${scrolling_orientation}view scroll [expr (-1)*$mousewheel_speed] units
            } elseif {$num == 5} {
                $scrolling_area ${scrolling_orientation}view scroll $mousewheel_speed units
            }
        }
    }
} elseif {$::tcl_platform(os) eq "Windows NT"} {
    oo::define Scrolling_Area method OnMouseWheel delta {
        if {$scrolling_orientation ne ""} {            
            $scrolling_area ${scrolling_orientation}view scroll [expr "(-1)*int($delta/120)*$mousewheel_speed"] units
        }
    }
        
} elseif {$::tcl_platform(os) eq "MacOS" || $::tcl_platform(os) eq "Darwin"} {
    oo::define Scrolling_Area method OnMouseWheel delta {
        if {$scrolling_orientation ne ""} {
            $scrolling_area ${scrolling_orientation}view $view_command scroll $delta units
        }
    }
}


#
# This is an example of usage
#

set scrolling_area [Scrolling_Area new ""]
$scrolling_area pack -expand 1 -fill both
    
for {set i 0} {$i < 20} {incr i} {
    set row_frame [::frame [$scrolling_area inner_frame].$i]
    pack $row_frame

    for {set j 0} {$j < 8} {incr j} {
        pack [label $row_frame.$j -text "Label $i $j"] -side left
    }
}


[Category Tcl Tk][Category Scrolled frame][Category mouse support]