Tk Source Code

Artifact 3e416f1ec89233082727c83ddc8a7ede1dcb4d053478ae7057630cd68a2bd1e8:

Attachment "test_scrollbar_perf.tcl" to ticket [7caf9e9e] added by oehhar 2026-05-28 09:33:44.

---

package require Tk

# Create a semi-transparent thumb image (rounded rectangle with alpha edges)
image create photo img_thumb -width 14 -height 24
img_thumb put [string repeat {{#505050} } 14] -to 0 0 14 24
img_thumb transparency set 0 0 1
img_thumb transparency set 13 0 1
img_thumb transparency set 0 23 1
img_thumb transparency set 13 23 1
# Semi-transparent corners via partial alpha
img_thumb put {{#80505050}} -to 1 0 2 1
img_thumb put {{#80505050}} -to 12 0 13 1
img_thumb put {{#80505050}} -to 1 23 2 24
img_thumb put {{#80505050}} -to 12 23 13 24

# Trough image (solid dark)
image create photo img_trough -width 14 -height 14
img_trough put [string repeat {{#2a2a2a} } 14] -to 0 0 14 14

# Arrow images
image create photo img_uparrow -width 14 -height 10
img_uparrow put [string repeat {{#3a3a3a} } 14] -to 0 0 14 10
image create photo img_downarrow -width 14 -height 10
img_downarrow put [string repeat {{#3a3a3a} } 14] -to 0 0 14 10

# Create custom theme elements
ttk::style element create MyCustom.Vscroll.trough image img_trough \
    -border {4 4 4 4} -sticky nswe
ttk::style element create MyCustom.Vscroll.thumb image img_thumb \
    -border {4 6 4 6} -sticky nswe
ttk::style element create MyCustom.Vscroll.uparrow image img_uparrow
ttk::style element create MyCustom.Vscroll.downarrow image img_downarrow

# Wire up the layout
ttk::style layout Vertical.TScrollbar {
    MyCustom.Vscroll.trough -sticky ns -children {
        MyCustom.Vscroll.uparrow   -side top    -sticky {}
        MyCustom.Vscroll.downarrow -side bottom -sticky {}
        MyCustom.Vscroll.thumb     -sticky nswe
    }
}

# Build UI
frame .f
text .f.t -wrap none -width 60 -height 30 \
    -yscrollcommand {.f.vs set} -xscrollcommand {.f.hs set}
ttk::scrollbar .f.vs -orient vertical -command {.f.t yview}
ttk::scrollbar .f.hs -orient horizontal -command {.f.t xview}

grid .f.t  -row 0 -column 0 -sticky nswe
grid .f.vs -row 0 -column 1 -sticky ns
grid .f.hs -row 1 -column 0 -sticky ew
grid rowconfigure .f 0 -weight 1
grid columnconfigure .f 0 -weight 1
pack .f -fill both -expand 1

# Fill with content to enable scrolling
for {set i 1} {$i <= 200} {incr i} {
    .f.t insert end "Line $i: [string repeat {abcdefgh } 20]\n"
}
.f.t see 1.0

wm title . "Scrollbar Perf Test"
wm geometry . 600x500