1# Copyright (c) 2006-2011 Tim Baker 2 3namespace eval DemoColumnLock {} 4 5proc DemoColumnLock::Init {T} { 6 7 variable Priv 8 9 InitPics *checked 10 11 # 12 # Configure the treectrl widget 13 # 14 15 $T configure \ 16 -showbuttons no \ 17 -showlines no \ 18 -showroot no \ 19 -xscrollincrement 40 -xscrolldelay 50 -xscrollsmoothing yes \ 20 -yscrollincrement 0 -yscrolldelay 50 -yscrollsmoothing yes 21 22 # 23 # Create columns 24 # 25 26 for {set i 0} {$i < 100} {incr i} { 27 $T column create -text "C$i" -tags C$i -width [expr {40 + 20 * ($i % 2)}] -justify center 28 } 29 $T column configure first -text LEFT -lock left -width "" 30 $T column configure last -text RIGHT -lock right -width "" 31 32 $T item state define CHECK 33 $T item state define mouseover 34 35 # 36 # Create styles for the left-locked column, and create items 37 # 38 39 $T element create label1.bg rect -fill {gray80 mouseover gray {}} 40 $T element create label1.text text 41 $T style create label1 -orient horizontal 42 $T style elements label1 {label1.bg label1.text} 43 $T style layout label1 label1.bg -detach yes -iexpand xy 44 $T style layout label1 label1.text -expand wns -padx 2 45 46 for {set i 1} {$i <= 10} {incr i} { 47 set I [$T item create -tags R$i -parent root] 48 $T item style set $I C0 label1 49 $T item text $I C0 "R$i" 50 } 51 52 $T element create label2.bd border -background $::SystemButtonFace \ 53 -relief raised -thickness 2 -filled yes 54 $T element create label2.text text 55 $T style create label2 -orient horizontal 56 $T style elements label2 {label2.bd label2.text} 57 $T style layout label2 label2.bd -detach yes -iexpand xy 58 $T style layout label2 label2.text -expand news -padx 2 -pady 2 59 60 for {set i 11} {$i <= 20} {incr i} { 61 set I [$T item create -tags R$i -parent root] 62 $T item style set $I C0 label2 63 $T item text $I C0 "R$i" 64 } 65 66 $T element create label3.div rect -fill black -height 2 67 $T element create label3.text text 68 $T style create label3 -orient horizontal 69 $T style elements label3 {label3.div label3.text} 70 $T style layout label3 label3.div -detach yes -expand n -iexpand x 71 $T style layout label3 label3.text -expand ws -padx 2 -pady 2 72 73 for {set i 21} {$i <= 30} {incr i} { 74 set I [$T item create -tags R$i -parent root] 75 $T item style set $I C0 label3 76 $T item text $I C0 "R$i" 77 } 78 79 $T element create label4.rect rect -fill {#e0e8f0 mouseover} 80 $T element create label4.text text 81 $T element create label4.w window -clip yes -destroy yes 82 $T style create label4 -orient vertical 83 $T style elements label4 {label4.rect label4.text label4.w} 84 $T style layout label4 label4.rect -detach yes -iexpand xy 85 $T style layout label4 label4.text -expand we -padx 2 -pady 2 86 $T style layout label4 label4.w -iexpand x -padx 2 -pady {0 2} 87 88 for {set i 31} {$i <= 40} {incr i} { 89 set I [$T item create -tags R$i -parent root] 90 $T item style set $I C0 label4 91 $T item element configure $I C0 label4.text -textvariable ::DemoColumnLock::Priv(R$i) 92 set clip [frame $T.clipR${I}C0 -borderwidth 0] 93 $::entryCmd $clip.e -width 4 -textvariable ::DemoColumnLock::Priv(R$i) 94 $T item element configure $I C0 label4.w -window $clip 95 set Priv(R$i) "R$i" 96 } 97 98 # 99 # Create styles for the right-locked column 100 # 101 102 $T element create labelR1.bg rect -fill {gray80 mouseover gray {}} 103 $T element create labelR1.img image -image {checked CHECK unchecked {}} 104 $T style create labelR1 -orient horizontal 105 $T style elements labelR1 {labelR1.bg labelR1.img} 106 $T style layout labelR1 labelR1.bg -detach yes -iexpand xy 107 $T style layout labelR1 labelR1.img -expand news -padx 2 -pady 2 108 109 $T element create labelR2.bd border -background $::SystemButtonFace \ 110 -relief raised -thickness 2 -filled yes 111 $T element create labelR2.img image -image {checked CHECK unchecked {}} 112 $T style create labelR2 -orient horizontal 113 $T style elements labelR2 {labelR2.bd labelR2.img} 114 $T style layout labelR2 labelR2.bd -detach yes -iexpand xy 115 $T style layout labelR2 labelR2.img -expand news -padx 2 -pady 2 116 117 $T element create labelR3.div rect -fill black -height 2 118 $T element create labelR3.img image -image {checked CHECK unchecked {}} 119 $T style create labelR3 -orient horizontal 120 $T style elements labelR3 {labelR3.div labelR3.img} 121 $T style layout labelR3 labelR3.div -detach yes -expand n -iexpand x 122 $T style layout labelR3 labelR3.img -expand news -padx 2 -pady 2 123 124 $T element create labelR4.rect rect -fill {#e0e8f0 mouseover} 125 $T element create labelR4.img image -image {checked CHECK unchecked {}} 126 $T style create labelR4 -orient vertical 127 $T style elements labelR4 {labelR4.rect labelR4.img} 128 $T style layout labelR4 labelR4.rect -detach yes -iexpand xy 129 $T style layout labelR4 labelR4.img -expand news -padx 2 -pady 2 130 131 $T item style set {range R1 R10} last labelR1 132 $T item style set {range R11 R20} last labelR2 133 $T item style set {range R21 R30} last labelR3 134 $T item style set {range R31 R40} last labelR4 135 136 # 137 # Create styles for the non-locked columns 138 # 139 140 $T item state define selN 141 $T item state define selS 142 $T item state define selW 143 $T item state define selE 144 145 $T element create cell.bd rect -outline gray -outlinewidth 1 -open wn \ 146 -fill {gray80 mouseover #F7F7F7 CHECK} 147 set fill [list gray !focus $::SystemHighlight {}] 148 $T element create cell.selN rect -height 2 -fill $fill 149 $T element create cell.selS rect -height 2 -fill $fill 150 $T element create cell.selW rect -width 2 -fill $fill 151 $T element create cell.selE rect -width 2 -fill $fill 152 $T style create cell -orient horizontal 153 $T style elements cell {cell.bd cell.selN cell.selS cell.selW cell.selE} 154 $T style layout cell cell.bd -detach yes -iexpand xy 155 $T style layout cell cell.selN -detach yes -expand s -iexpand x -draw {no !selN} 156 $T style layout cell cell.selS -detach yes -expand n -iexpand x -draw {no !selS} 157 $T style layout cell cell.selW -detach yes -expand e -iexpand y -draw {no !selW} 158 $T style layout cell cell.selE -detach yes -expand w -iexpand y -draw {no !selE} 159 160 # NOTE 1: the following column descriptions are equivalent in this demo: 161 # "range {first next} {last prev}" 162 # "all lock none" (see note #2 below) 163 # "lock none !tail" 164 # The above item descriptions all specify the unlocked columns between 165 # the left-locked and right-locked columns. 166 167 $T item style set "root children" "range {first next} {last prev}" cell 168 169 $T element create windowStyle.rect rect -fill {#e0e8f0 mouseover #F7F7F7 CHECK} 170 $T element create windowStyle.text text 171 $T element create windowStyle.window window -clip yes -destroy yes 172 $T style create windowStyle -orient vertical 173 $T style elements windowStyle {windowStyle.rect windowStyle.text windowStyle.window} 174 $T style layout windowStyle windowStyle.rect -detach yes -iexpand xy 175 $T style layout windowStyle windowStyle.text -expand we -padx 2 -pady 2 176 $T style layout windowStyle windowStyle.window -iexpand x -padx 2 -pady {0 2} 177 178 # NOTE 2: "all lock none" also matches the tail column, however the 179 # [item style set] command does not operate on the tail column so it is 180 # ignored. Explicitly naming the tail column would result in an error 181 # however. Another example of this behaviour is [column delete all]. 182 183 $T item style set "list {R2 R22}" "all lock none" windowStyle 184 185 foreach C [$T column id "lock none !tail"] { 186 set Priv(C$C) [$T column cget $C -tags] 187 188 set I R2 189 set clip [frame $T.clipR${I}C$C -borderwidth 0] 190 $::entryCmd $clip.e -width 4 -textvariable ::DemoColumnLock::Priv(C$C) 191 $T item element configure $I $C windowStyle.window -window $clip + \ 192 windowStyle.text -textvariable ::DemoColumnLock::Priv(C$C) 193 194 set I R22 195 set clip [frame $T.clipR${I}C$C -borderwidth 0] 196 $::entryCmd $clip.e -width 4 -textvariable ::DemoColumnLock::Priv(C$C) 197 $T item element configure $I $C windowStyle.window -window $clip + \ 198 windowStyle.text -textvariable ::DemoColumnLock::Priv(C$C) 199 } 200 201 bind DemoColumnLock <ButtonPress-1> { 202 DemoColumnLock::Button1 %W %x %y 203 } 204 bind DemoColumnLock <Button1-Motion> { 205 DemoColumnLock::Motion1 %W %x %y 206 DemoColumnLock::Motion %W %x %y 207 } 208 bind DemoColumnLock <Motion> { 209 DemoColumnLock::Motion %W %x %y 210 } 211 212 set Priv(prev) "" 213 set Priv(selection) {} 214 215 bindtags $T [list $T DemoColumnLock TreeCtrl [winfo toplevel $T] all] 216 217 return 218} 219 220proc DemoColumnLock::Button1 {w x y} { 221 variable Priv 222 $w identify -array id $x $y 223 set Priv(selecting) 0 224 if {$id(where) eq "item"} { 225 set item $id(item) 226 set column $id(column) 227 if {[$w column compare $column == last]} { 228 $w item state set $item ~CHECK 229 return 230 } 231 if {[$w column cget $column -lock] eq "none"} { 232 set Priv(corner1) [list $item $column] 233 set Priv(corner2) $Priv(corner1) 234 set Priv(selecting) 1 235 UpdateSelection $w 236 } 237 } 238 return 239} 240 241proc DemoColumnLock::Motion1 {w x y} { 242 variable Priv 243 $w identify -array id $x $y 244 if {$id(where) eq "item"} { 245 set item $id(item) 246 set column $id(column) 247 if {[$w column cget $column -lock] eq "none"} { 248 if {$Priv(selecting)} { 249 set corner [list $item $column] 250 if {$corner ne $Priv(corner2)} { 251 set Priv(corner2) $corner 252 UpdateSelection $w 253 } 254 } 255 } 256 } 257 return 258} 259 260proc DemoColumnLock::Motion {w x y} { 261 variable Priv 262 $w identify -array id $x $y 263 if {$id(where) eq ""} { 264 # nothing 265 } elseif {$id(where) eq "header"} { 266 # nothing 267 } elseif {$id(where) eq "item"} { 268 set item $id(item) 269 set column $id(column) 270 set curr [list $item $column] 271 if {$curr ne $Priv(prev)} { 272 if {$Priv(prev) ne ""} { 273 eval $w item state forcolumn $Priv(prev) !mouseover 274 } 275 $w item state forcolumn $item $column mouseover 276 set Priv(prev) $curr 277 } 278 return 279 } 280 if {$Priv(prev) ne ""} { 281 eval $w item state forcolumn $Priv(prev) !mouseover 282 set Priv(prev) "" 283 } 284 return 285} 286 287proc DemoColumnLock::UpdateSelection {w} { 288 variable Priv 289 290 # Clear the old selection. 291 foreach {item column} $Priv(selection) { 292 $w item state forcolumn $item $column {!selN !selS !selE !selW} 293 } 294 set Priv(selection) {} 295 296 # Order the 2 corners. 297 foreach {item1 column1} $Priv(corner1) {} 298 foreach {item2 column2} $Priv(corner2) {} 299 if {[$w item compare $item1 > $item2]} { 300 set swap $item1 301 set item1 $item2 302 set item2 $swap 303 } 304 if {[$w column compare $column1 > $column2]} { 305 set swap $column1 306 set column1 $column2 307 set column2 $swap 308 } 309 310 # Set the state of every item-column on the edges of the selection. 311 $w item state forcolumn $item1 "range $column1 $column2" selN 312 $w item state forcolumn $item2 "range $column1 $column2" selS 313 $w item state forcolumn "range $item1 $item2" $column1 selW 314 $w item state forcolumn "range $item1 $item2" $column2 selE 315 316 # Remember every item-column on the edges of the selection. 317 foreach item [list $item1 $item2] { 318 foreach column [$w column id "range $column1 $column2"] { 319 lappend Priv(selection) $item $column 320 } 321 } 322 foreach item [$w item id "range $item1 $item2"] { 323 foreach column [list $column1 $column2] { 324 lappend Priv(selection) $item $column 325 } 326 } 327 return 328} 329 330proc DemoColumnLock::AddText {} { 331 set w [DemoList] 332 $w style elements cell {cell.bd label1.text cell.selN cell.selS cell.selW cell.selE} 333 $w item text visible {lock none} abc 334} 335