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