| [6d7779d] | 1 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2 | # FILE : bcomboboxplus.tcl |
|---|
| 3 | # PURPOSE : Bayes Combobox Plus. Component that allows to select an element, |
|---|
| 4 | # showing a list with all the information that necesary to select |
|---|
| 5 | # it. |
|---|
| 6 | # Once selected, the obtained result is divided for its |
|---|
| 7 | # presentation in 1+n parts: one for the key field and n for |
|---|
| 8 | # fields that we wish to show. n can be zero. |
|---|
| 9 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 10 | |
|---|
| 11 | package require byscommon |
|---|
| 12 | package require BLT |
|---|
| 13 | |
|---|
| 14 | package require blistboxplus |
|---|
| 15 | package require bentrydate |
|---|
| 16 | |
|---|
| 17 | |
|---|
| 18 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 19 | ::snit::widget bcomboboxplus { |
|---|
| 20 | # |
|---|
| 21 | # PURPOSE: Bayes Combobox Plus. Allows to choose an element of a list. |
|---|
| 22 | # |
|---|
| 23 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 24 | # SPECIFIC OPTIONS |
|---|
| 25 | # colkey -> Key column of comboboxplus. If it is not defined, |
|---|
| 26 | # the first column is taken like key. |
|---|
| 27 | # cols -> List of columns of the comboboxplus. Including hidden |
|---|
| 28 | # columns. Required. |
|---|
| 29 | # hiddencols -> Hidden columns of the comboboxplus. If it is not defined, |
|---|
| 30 | # all columns are visible. |
|---|
| 31 | # titles -> Title of each one of labels in the comboboxplus. |
|---|
| 32 | # colslb -> Columns of the listboxplus, including the hidden columns. |
|---|
| 33 | # If it is not defined, is taken the value of -cols. |
|---|
| 34 | # hiddencolslb -> Hidden columns of the listboxplus. If it is not defined, |
|---|
| 35 | # all columns are visible. |
|---|
| 36 | # parent -> Indicates the father where comboboxplus is located. If it |
|---|
| 37 | # is not defined, the parent is . |
|---|
| 38 | # showlabelkey -> If it has value 1 it shows label of the key on |
|---|
| 39 | # bcomboboxplus. Default 0. |
|---|
| 40 | # showlabels -> If it has value 1 it shows the labels of not hidden fields |
|---|
| 41 | # that hasn't the key. Default 0. |
|---|
| 42 | # width -> Width of entrys. Can be a list or a value (all entrys |
|---|
| 43 | # will have the same width). Default 10. |
|---|
| 44 | # keyhelptext -> List of helptext that is showed when the mouse is over the |
|---|
| 45 | # entry of the key. |
|---|
| 46 | # helptexts -> List of helptext that is showed when the mouse is over the |
|---|
| 47 | # entrys of the fields. |
|---|
| 48 | # modifycmd -> Command to execute after selecting an item. |
|---|
| 49 | # postcommand -> Command to execute before showing the list. |
|---|
| 50 | # color -> Colour of the labels (red, blue, etc.). Default "black". |
|---|
| 51 | # nrows -> Number of visible rows of blistboxplus. |
|---|
| 52 | # variable -> Variable with text of entry key |
|---|
| 53 | # text -> Text of the entry of the key field. |
|---|
| 54 | # widthlb -> Width of the pop-up blistboxplus. Default 350. If has a |
|---|
| 55 | # value "auto" it autoadjust to width of entry of the key. |
|---|
| 56 | # keydate -> If has a value 1, the widget of the key will be a |
|---|
| 57 | # bentrydate instead of an Entry. This option only can be set |
|---|
| 58 | # on creation time. |
|---|
| 59 | # fieldsdate -> Takes a list that for each field of bcomboboxplus, if has a |
|---|
| 60 | # value 1, the widget of this field will be abentrydate |
|---|
| 61 | # instead of an Entry. This option only can be set on |
|---|
| 62 | # creation time. |
|---|
| 63 | # font -> Font used in the widget. Is a list with the name and the |
|---|
| 64 | # size of the font. |
|---|
| 65 | # varcol -> Name of the field whose entry will be associated the |
|---|
| 66 | # variable defined in the option -variable. If it's empty, |
|---|
| 67 | # this variable will be associated to the entry of the key. |
|---|
| 68 | # keypress -> Activates the search by pressed keys |
|---|
| 69 | # colkeypress -> Column by which the search when pressing is made a key |
|---|
| 70 | # |
|---|
| 71 | # VARIABLES |
|---|
| 72 | # lblKey -> Label next to key field. |
|---|
| 73 | # entryKey -> Entry that content the key field. |
|---|
| 74 | # arrowBtn -> Arrow button. |
|---|
| 75 | # created -> Indicates if witget has been created. |
|---|
| 76 | # fr -> Pop-up frame with blistboxplus. |
|---|
| 77 | # in -> It takes a value 1 if the cursor is located in the |
|---|
| 78 | # pop-up frame of listbox. |
|---|
| 79 | # ncols -> Number of columns. |
|---|
| 80 | # colGrid($widget) -> Array with column where was grided the widget $widget. |
|---|
| 81 | # e -> Array of entrys (or bentrydates) of the fields |
|---|
| 82 | # blstentry -> lista de objetos entry visualizados |
|---|
| 83 | # |
|---|
| 84 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 85 | widgetclass Bcomboboxplus |
|---|
| 86 | |
|---|
| 87 | option -titles {} |
|---|
| 88 | option -cols {} |
|---|
| 89 | option -hiddencols {} |
|---|
| 90 | option -colslb {} |
|---|
| 91 | option -hiddencolslb {} |
|---|
| 92 | option -parent . |
|---|
| 93 | option -showlabelkey 0 |
|---|
| 94 | option -showlabels 0 |
|---|
| 95 | option -colkey "" |
|---|
| 96 | option -width 10 |
|---|
| 97 | option -keyhelptext "" |
|---|
| 98 | option -helptexts "" |
|---|
| 99 | option -modifycmd "" |
|---|
| 100 | option -postcommand "" |
|---|
| 101 | option -color {Black} |
|---|
| 102 | option -nrows 5 |
|---|
| 103 | option -widthlb 350 |
|---|
| 104 | option -variable "" |
|---|
| 105 | option -text "" |
|---|
| 106 | option -keydate 0 |
|---|
| 107 | option -fieldsdate {} |
|---|
| 108 | option -font {Arial 8} |
|---|
| 109 | option -varcol "" |
|---|
| 110 | option -keypress true |
|---|
| 111 | option -colkeypress "" |
|---|
| 112 | |
|---|
| 113 | variable lblKey |
|---|
| 114 | variable entryKey |
|---|
| 115 | variable arrowBtn |
|---|
| 116 | variable menu |
|---|
| 117 | variable lstBox |
|---|
| 118 | variable created 0 |
|---|
| 119 | variable fr |
|---|
| 120 | variable in |
|---|
| 121 | variable e |
|---|
| 122 | variable ncols 0 |
|---|
| 123 | variable helptexts |
|---|
| 124 | variable colGrid |
|---|
| 125 | variable varKey "" |
|---|
| 126 | variable blstentry {} |
|---|
| 127 | variable vez 0 |
|---|
| 128 | variable lstPreVal {} |
|---|
| 129 | variable idxFind {} |
|---|
| 130 | variable valBusqueda "" |
|---|
| 131 | |
|---|
| 132 | |
|---|
| 133 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 134 | constructor {args} { |
|---|
| 135 | # |
|---|
| 136 | # PURPOSE: Constructor for bcomboboxplus. |
|---|
| 137 | # |
|---|
| 138 | # PARAMETERS: |
|---|
| 139 | # args -> List of options for comboboxplus |
|---|
| 140 | # |
|---|
| 141 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 142 | $self configure -font [from args -font ""] |
|---|
| 143 | install lblKey using Label $self.lk -font [$self cget -font] |
|---|
| 144 | install arrowbtn using ArrowButton $self.ab -dir bottom |
|---|
| 145 | |
|---|
| 146 | $self configure -keypress [from args -keypress true] |
|---|
| 147 | $self configure -colkeypress [from args -colkeypress ""] |
|---|
| 148 | $self configure -keydate [from args -keydate ""] |
|---|
| 149 | $self configure -fieldsdate [from args -fieldsdate ""] |
|---|
| 150 | $self configure -cols [from args -cols ""] |
|---|
| 151 | $self configure -colkey [from args -colkey ""] |
|---|
| 152 | $self configure -widthlb [from args -widthlb ""] |
|---|
| 153 | $self configure -width [from args -width ""] |
|---|
| 154 | |
|---|
| 155 | $self configure -keyhelptext [from args -keyhelptext ""] |
|---|
| 156 | $self configure -helptexts [from args -helptexts ""] |
|---|
| 157 | $self configure -color [from args -color ""] |
|---|
| 158 | $self configure -modifycmd [from args -modifycmd ""] |
|---|
| 159 | $self configure -postcommand [from args -postcommand ""] |
|---|
| 160 | $self configure -nrows [from args -nrows ""] |
|---|
| 161 | $self configure -variable [from args -variable ""] |
|---|
| 162 | $self configure -varcol [from args -varcol ""] |
|---|
| 163 | |
|---|
| 164 | # Create the widget |
|---|
| 165 | $self createwidget $args |
|---|
| 166 | $self configure -colslb [from args -colslb ""] |
|---|
| 167 | $self configure -text [from args -text ""] |
|---|
| 168 | $self configure -showlabels [from args -showlabels ""] |
|---|
| 169 | $self configure -showlabelkey [from args -showlabelkey ""] |
|---|
| 170 | $self configure -titles [from args -titles ""] |
|---|
| 171 | |
|---|
| 172 | # Apply all arguments given: |
|---|
| 173 | $self configurelist $args |
|---|
| 174 | |
|---|
| 175 | # Widget is now created |
|---|
| 176 | set created 1 |
|---|
| 177 | |
|---|
| 178 | # initializes the widget |
|---|
| 179 | $self _Init |
|---|
| 180 | } |
|---|
| 181 | |
|---|
| 182 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 183 | # |
|---|
| 184 | # PURPOSE: Methods cget & configure |
|---|
| 185 | # |
|---|
| 186 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 187 | onconfigure -width { lst } { |
|---|
| 188 | if {[llength $lst]} { ;# 1 item |
|---|
| 189 | set aux $lst |
|---|
| 190 | for {set c 1} {$c<$ncols} {incr c} { |
|---|
| 191 | set lst [concat $lst $aux] |
|---|
| 192 | } |
|---|
| 193 | } |
|---|
| 194 | set options(-width) $lst |
|---|
| 195 | # Widget created |
|---|
| 196 | if {$created} { |
|---|
| 197 | $self.ek configure -width [lindex [$self cget -width ] [$self _PosKey]] |
|---|
| 198 | #width of fields labels |
|---|
| 199 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 200 | set name [lindex [$self cget -cols ] $c] |
|---|
| 201 | $e($name) configure -width [lindex [$self cget -width ] $c] |
|---|
| 202 | } |
|---|
| 203 | } |
|---|
| 204 | } |
|---|
| 205 | |
|---|
| 206 | |
|---|
| 207 | onconfigure -colkey { value } { |
|---|
| 208 | if {$value eq ""} { |
|---|
| 209 | set value [lindex [$self cget -cols] 0] |
|---|
| 210 | } |
|---|
| 211 | set options(-colkey) $value |
|---|
| 212 | # Widget created |
|---|
| 213 | if {$created == 1} { |
|---|
| 214 | set lbrow [$lstBox selection get] |
|---|
| 215 | # the selection now doesn't exists in blistboxplus |
|---|
| 216 | if {$lbrow != ""} { |
|---|
| 217 | set selected [$lstBox get $lbrow] |
|---|
| 218 | } |
|---|
| 219 | # Updates the label and entry for the key field |
|---|
| 220 | $self.lk configure -text [lindex [$self cget -titles ] [$self _PosKey]] |
|---|
| 221 | if { [$self.ek cget -text] != "" } { |
|---|
| 222 | if {$lbrow != ""} { |
|---|
| 223 | $self.ek configure -text [lindex $selected [$self _PosKey]] |
|---|
| 224 | } else { |
|---|
| 225 | # Imposible to update from blistboxplus |
|---|
| 226 | $self.ek configure -text "" |
|---|
| 227 | } |
|---|
| 228 | } |
|---|
| 229 | # Updates other fields |
|---|
| 230 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 231 | set name [lindex [$self cget -cols ] $c] |
|---|
| 232 | if {$lbrow != ""} { |
|---|
| 233 | $e($name) configure -text [lindex $selected $c] |
|---|
| 234 | } else { |
|---|
| 235 | # Imposible to update from blistboxplus |
|---|
| 236 | $e($name) configure -text "" |
|---|
| 237 | } |
|---|
| 238 | # Grid this field |
|---|
| 239 | |
|---|
| 240 | grid $self.l$name |
|---|
| 241 | if { $name eq [lindex [$self cget -cols ] [$self _PosKey]]} { |
|---|
| 242 | #grid $self.e$name -sticky {} |
|---|
| 243 | } else { |
|---|
| 244 | grid $e($name) -sticky ew |
|---|
| 245 | grid columnconfigure $self $colGrid($e($name)) -weight 1 |
|---|
| 246 | } |
|---|
| 247 | } |
|---|
| 248 | # Hides the field of the key in the other fields |
|---|
| 249 | set name [lindex [$self cget -cols ] [$self _PosKey]] |
|---|
| 250 | grid remove $self.l$name |
|---|
| 251 | grid remove $e($name) |
|---|
| 252 | grid columnconfigure $self $colGrid($e($name)) -weight 0 |
|---|
| 253 | $self configure -hiddencols [$self cget -hiddencols] |
|---|
| 254 | } |
|---|
| 255 | } |
|---|
| 256 | |
|---|
| 257 | onconfigure -titles { lst } { |
|---|
| 258 | set options(-titles) $lst |
|---|
| 259 | if {!($lst eq "")} { |
|---|
| 260 | # Configures the title of key field |
|---|
| 261 | $self.lk configure -text [lindex [$self cget -titles ] 0] |
|---|
| 262 | # Configures the rest of titles |
|---|
| 263 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 264 | set name [lindex [$self cget -cols ] $c] |
|---|
| 265 | set shown [winfo exist $self.l$name] |
|---|
| 266 | if { $shown == 1 } { |
|---|
| 267 | $self.l$name configure -text [lindex [$self cget -titles ] $c] |
|---|
| 268 | } |
|---|
| 269 | } |
|---|
| 270 | $lstBox configure -titles $lst |
|---|
| 271 | } |
|---|
| 272 | } |
|---|
| 273 | |
|---|
| 274 | onconfigure -cols { lst } { |
|---|
| 275 | set options(-cols) $lst |
|---|
| 276 | # Establishes the number of columns |
|---|
| 277 | set ncols [llength [$self cget -cols]] |
|---|
| 278 | } |
|---|
| 279 | |
|---|
| 280 | onconfigure -hiddencols { lst } { |
|---|
| 281 | set options(-hiddencols) $lst |
|---|
| 282 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 283 | if { $c != [$self _PosKey] } { |
|---|
| 284 | set aux [expr $c + 1] |
|---|
| 285 | set name [lindex [$self cget -cols ] $c] |
|---|
| 286 | set fieldCreated [lsearch -glob [grid slaves $self] $e($name)] |
|---|
| 287 | set hidden [lsearch -glob [$self cget -hiddencols ] $name] |
|---|
| 288 | if { $fieldCreated == "-1" } { |
|---|
| 289 | # Shows this field |
|---|
| 290 | grid $e($name) |
|---|
| 291 | grid columnconfigure $self $colGrid($e($name)) -weight 1 |
|---|
| 292 | grid $self.l$name |
|---|
| 293 | } |
|---|
| 294 | if { $hidden != "-1" } { |
|---|
| 295 | # Hiddes this field |
|---|
| 296 | grid remove $e($name) |
|---|
| 297 | grid columnconfigure $self $colGrid($e($name)) -weight 0 |
|---|
| 298 | grid remove $self.l$name |
|---|
| 299 | } |
|---|
| 300 | } |
|---|
| 301 | } |
|---|
| 302 | $self configure -showlabels [$self cget -showlabels] |
|---|
| 303 | } |
|---|
| 304 | |
|---|
| 305 | onconfigure -showlabels { value } { |
|---|
| 306 | set options(-showlabels) $value |
|---|
| 307 | # Show labels |
|---|
| 308 | if { $value == 0 } { |
|---|
| 309 | # Show labels off |
|---|
| 310 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 311 | if {$c != [$self _PosKey]} { |
|---|
| 312 | set name [lindex [$self cget -cols ] $c] |
|---|
| 313 | set exists [winfo exist $self.l$name] |
|---|
| 314 | if { $exists == 1 } { |
|---|
| 315 | grid remove $self.l$name |
|---|
| 316 | } |
|---|
| 317 | } |
|---|
| 318 | } |
|---|
| 319 | } else { |
|---|
| 320 | # Show labels on |
|---|
| 321 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 322 | if {$c != [$self _PosKey]} { |
|---|
| 323 | set name [lindex [$self cget -cols ] $c] |
|---|
| 324 | set exists [winfo exist $self.l$name] |
|---|
| 325 | if { $exists == 1 } { |
|---|
| 326 | set hidden [lsearch -glob [$self cget -hiddencols ] $name] |
|---|
| 327 | if { $hidden == -1 } { |
|---|
| 328 | grid $self.l$name |
|---|
| 329 | } else { |
|---|
| 330 | grid remove $self.l$name |
|---|
| 331 | } |
|---|
| 332 | } |
|---|
| 333 | } |
|---|
| 334 | } |
|---|
| 335 | } |
|---|
| 336 | } |
|---|
| 337 | |
|---|
| 338 | onconfigure -showlabelkey { value } { |
|---|
| 339 | set options(-showlabelkey) $value |
|---|
| 340 | if { $value == 0 } { |
|---|
| 341 | # Show label key off |
|---|
| 342 | grid remove $self.lk |
|---|
| 343 | } else { |
|---|
| 344 | # Show label key on |
|---|
| 345 | grid $self.lk |
|---|
| 346 | } |
|---|
| 347 | } |
|---|
| 348 | |
|---|
| 349 | onconfigure -colslb { lst } { |
|---|
| 350 | if {$lst eq ""} { |
|---|
| 351 | set lst [$self cget -cols] |
|---|
| 352 | } |
|---|
| 353 | set options(-colslb) $lst |
|---|
| 354 | if { $created == 1 } { |
|---|
| 355 | $self _ShowList |
|---|
| 356 | $lstBox configure -cols $lst |
|---|
| 357 | $self _CloseList |
|---|
| 358 | } else { |
|---|
| 359 | $lstBox configure -cols $lst |
|---|
| 360 | } |
|---|
| 361 | } |
|---|
| 362 | |
|---|
| 363 | onconfigure -hiddencolslb { lst } { |
|---|
| 364 | set options(-hiddencolslb) $lst |
|---|
| 365 | if { $created == 1 } { |
|---|
| 366 | #$self _ShowList |
|---|
| 367 | eval $lstBox configure -hiddencols \ |
|---|
| 368 | [lappend [$self cget -hiddencolslb] $lst] |
|---|
| 369 | #$self _CloseList |
|---|
| 370 | } else { |
|---|
| 371 | eval $lstBox configure -hiddencols \ |
|---|
| 372 | [lappend [$self cget -hiddencolslb] $lst] |
|---|
| 373 | } |
|---|
| 374 | } |
|---|
| 375 | |
|---|
| 376 | onconfigure -keyhelptext { value } { |
|---|
| 377 | set options(-keyhelptext) $value |
|---|
| 378 | } |
|---|
| 379 | |
|---|
| 380 | onconfigure -helptexts { lst } { |
|---|
| 381 | set options(-helptexts) $lst |
|---|
| 382 | } |
|---|
| 383 | |
|---|
| 384 | onconfigure -color { value } { |
|---|
| 385 | set options(-color) $value |
|---|
| 386 | } |
|---|
| 387 | |
|---|
| 388 | onconfigure -modifycmd { lst } { |
|---|
| 389 | set options(-modifycmd) $lst |
|---|
| 390 | } |
|---|
| 391 | |
|---|
| 392 | onconfigure -postcommand { lst } { |
|---|
| 393 | set options(-postcommand) $lst |
|---|
| 394 | } |
|---|
| 395 | |
|---|
| 396 | onconfigure -nrows { value } { |
|---|
| 397 | set options(-nrows) $value |
|---|
| 398 | } |
|---|
| 399 | |
|---|
| 400 | onconfigure -widthlb { value } { |
|---|
| 401 | set options(-widthlb) $value |
|---|
| 402 | } |
|---|
| 403 | |
|---|
| 404 | onconfigure -variable { value } { |
|---|
| 405 | if { $created == 1 } { |
|---|
| 406 | puts "Bcomboboxplus onconfigure -variable error: this option only\ |
|---|
| 407 | can be configured on creation time." |
|---|
| 408 | } else { |
|---|
| 409 | if {[llength value] eq 0} { |
|---|
| 410 | # default value |
|---|
| 411 | set options(-variable) [varname varKey] |
|---|
| 412 | } else { |
|---|
| 413 | set options(-variable) $value |
|---|
| 414 | } |
|---|
| 415 | } |
|---|
| 416 | } |
|---|
| 417 | |
|---|
| 418 | onconfigure -text { value } { |
|---|
| 419 | set options(-text) $value |
|---|
| 420 | if { $created == 1 } { |
|---|
| 421 | $self.ek configure -text $value |
|---|
| 422 | } |
|---|
| 423 | } |
|---|
| 424 | |
|---|
| 425 | onconfigure -keydate { value } { |
|---|
| 426 | if { $created == 1 } { |
|---|
| 427 | puts "Bcomboboxplus onconfigure -keydate error: this option only can\ |
|---|
| 428 | be configured on creation time." |
|---|
| 429 | } else { |
|---|
| 430 | set options(-keydate) $value |
|---|
| 431 | } |
|---|
| 432 | } |
|---|
| 433 | |
|---|
| 434 | onconfigure -fieldsdate { lst } { |
|---|
| 435 | if { $created == 1 } { |
|---|
| 436 | puts "Bcomboboxplus onconfigure -fieldsdate error: this option only\ |
|---|
| 437 | can be configured on creation time." |
|---|
| 438 | } else { |
|---|
| 439 | set options(-fieldsdate) $lst |
|---|
| 440 | } |
|---|
| 441 | } |
|---|
| 442 | |
|---|
| 443 | onconfigure -varcol { value } { |
|---|
| 444 | if { $created == 1 } { |
|---|
| 445 | puts "Bcomboboxplus onconfigure -varcol error: this option only\ |
|---|
| 446 | can be configured on creation time." |
|---|
| 447 | } else { |
|---|
| 448 | if {$value eq ""} { |
|---|
| 449 | # by default gives the -colkey option value |
|---|
| 450 | set options(-varcol) "key" |
|---|
| 451 | } else { |
|---|
| 452 | if { [lsearch -exact [$self cget -cols ] $value ] eq -1 } { |
|---|
| 453 | puts "Bcomboboxplus onconfigure -varcol error: the argument given \ |
|---|
| 454 | '$value' must be a valid column." |
|---|
| 455 | } else { |
|---|
| 456 | set options(-varcol) $value |
|---|
| 457 | } |
|---|
| 458 | } |
|---|
| 459 | } |
|---|
| 460 | } |
|---|
| 461 | |
|---|
| 462 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 463 | method createwidget { args } { |
|---|
| 464 | # |
|---|
| 465 | # PURPOSE: Creation of the objects that compose the widget. |
|---|
| 466 | # |
|---|
| 467 | # PARAMETERS: |
|---|
| 468 | # args -> List of options for the bcomboboxplus. |
|---|
| 469 | # |
|---|
| 470 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 471 | global tcl_platform |
|---|
| 472 | update |
|---|
| 473 | set blstentry {} |
|---|
| 474 | set colAct 0 |
|---|
| 475 | # Creates the label, entry and arrowbutton for the key field |
|---|
| 476 | $self.lk configure -text [lindex [$self cget -titles ] [$self _PosKey]] \ |
|---|
| 477 | -helptext [$self cget -keyhelptext ] \ |
|---|
| 478 | -foreground [$self cget -color ] |
|---|
| 479 | # entryKey gives the type of widget set in option -keydate |
|---|
| 480 | if {[$self cget -keydate]} { |
|---|
| 481 | set entryKey [bentrydate $self.ek ] |
|---|
| 482 | } else { |
|---|
| 483 | set entryKey [Entry $self.ek -takefocus 1 -font [$self cget -font]] |
|---|
| 484 | } |
|---|
| 485 | lappend blstentry $entryKey |
|---|
| 486 | grid $self.lk -row 0 -column $colAct |
|---|
| 487 | incr colAct |
|---|
| 488 | grid $self.ek -row 0 -column $colAct -sticky ew |
|---|
| 489 | set colGrid($self.ek) $colAct |
|---|
| 490 | |
|---|
| 491 | $self.ek configure -width [lindex [$self cget -width ] [$self _PosKey]] |
|---|
| 492 | $self.ek configure -helptext [$self cget -keyhelptext ] |
|---|
| 493 | grid columnconfigure $self $colAct -weight 1 |
|---|
| 494 | incr colAct |
|---|
| 495 | $self.ab configure -helptext [mc "List of values"] \ |
|---|
| 496 | -command [list $self _ShowList] -height 20 -highlightthickness 0 \ |
|---|
| 497 | -borderwidth 1 -takefocus 0 -type button -ipadx 1 |
|---|
| 498 | grid $self.ab -row 0 -column $colAct |
|---|
| 499 | incr colAct |
|---|
| 500 | # Creates labels and entrys for all fields |
|---|
| 501 | incr colAct |
|---|
| 502 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 503 | set name [lindex [$self cget -cols ] $c] |
|---|
| 504 | # Creates a label |
|---|
| 505 | install l$name using Label $self.l$name -font [$self cget -font] \ |
|---|
| 506 | -foreground [$self cget -color ] |
|---|
| 507 | $self.l$name configure -text [lindex [$self cget -titles ] $c] |
|---|
| 508 | $self.l$name configure -helptext [lindex [$self cget -helptexts ] $c] |
|---|
| 509 | grid $self.l$name -row 0 -column $colAct |
|---|
| 510 | incr colAct |
|---|
| 511 | |
|---|
| 512 | # Creates an entry |
|---|
| 513 | if { [info exist [lindex [$self cget -fieldsdate] $c] ] eq 0 } { |
|---|
| 514 | if { [ lindex [$self cget -fieldsdate] $c ] eq 1 } { |
|---|
| 515 | set e($name) [bentrydate $self.ed$name] |
|---|
| 516 | } else { |
|---|
| 517 | set e($name) [Entry $self.en$name -font [$self cget -font] ] |
|---|
| 518 | } |
|---|
| 519 | } else { |
|---|
| 520 | set e($name) [Entry $self.en$name -font [$self cget -font] ] |
|---|
| 521 | } |
|---|
| 522 | lappend blstentry $e($name) |
|---|
| 523 | |
|---|
| 524 | set aux [$self cget -width ] |
|---|
| 525 | $e($name) configure -width [lindex [$self cget -width ] $c] |
|---|
| 526 | $e($name) configure -helptext [lindex [$self cget -helptexts ] $c] |
|---|
| 527 | |
|---|
| 528 | grid $e($name) -row 0 -column $colAct -sticky ew |
|---|
| 529 | grid columnconfigure $self $colAct -weight 1 |
|---|
| 530 | set colGrid($e($name)) $colAct |
|---|
| 531 | incr colAct |
|---|
| 532 | } |
|---|
| 533 | #Set the variable for the field of varname |
|---|
| 534 | if { !([$self cget -variable] eq "") } { |
|---|
| 535 | set varn [$self cget -variable ] |
|---|
| 536 | if { [$self cget -varcol ] eq "key" } { |
|---|
| 537 | # variable is set to the entry of the key |
|---|
| 538 | $self.ek configure -textvariable $varn |
|---|
| 539 | } else { |
|---|
| 540 | # variable is set to another entry |
|---|
| 541 | $e([$self cget -varcol ]) configure -textvariable $varn |
|---|
| 542 | } |
|---|
| 543 | } |
|---|
| 544 | #Remove the label and entry on the fields |
|---|
| 545 | set name [lindex [$self cget -cols ] [$self _PosKey]] |
|---|
| 546 | grid remove $self.l$name |
|---|
| 547 | grid remove $e($name) |
|---|
| 548 | grid columnconfigure $self $colGrid($e($name)) -weight 0 |
|---|
| 549 | #Top-level pull-down |
|---|
| 550 | set fr [toplevel $self.fr -borderwidth 0 -relief solid \ |
|---|
| 551 | -highlightthickness 0 -takefocus 0 -bd 1 ] |
|---|
| 552 | wm withdraw $fr |
|---|
| 553 | if { [string equal $tcl_platform(platform) "windows"] } { |
|---|
| 554 | update idletasks |
|---|
| 555 | } |
|---|
| 556 | wm overrideredirect $fr 1 |
|---|
| 557 | wm transient $fr [winfo toplevel $self] |
|---|
| 558 | wm withdraw $fr |
|---|
| 559 | wm resizable $fr 0 0 |
|---|
| 560 | |
|---|
| 561 | # width of the listboxplus |
|---|
| 562 | set wlb 0 |
|---|
| 563 | for {set c 0} {$c < [llength $aux]} {incr c 1} { |
|---|
| 564 | set name [lindex [$self cget -cols ] $c] |
|---|
| 565 | set hidden [lsearch -glob [$self cget -hiddencols ] $name] |
|---|
| 566 | if {$hidden == -1} { |
|---|
| 567 | set wlb [expr $wlb + [lindex $aux $c ] ] |
|---|
| 568 | } |
|---|
| 569 | } |
|---|
| 570 | set lstBox [blistboxplus $fr.blb -cols [ $self cget -colslb ] \ |
|---|
| 571 | -hiddencols [ $self cget -hiddencolslb ] -parent $self \ |
|---|
| 572 | -orientation vertical -selectmode single\ |
|---|
| 573 | -width $wlb -font [$self cget -font] \ |
|---|
| 574 | -exportselection false -border 0 -height 0 -nomenu 1] |
|---|
| 575 | |
|---|
| 576 | pack $lstBox -side top -fill both -expand yes |
|---|
| 577 | #grid $lstBox -sticky news |
|---|
| 578 | set in 1; |
|---|
| 579 | bind $fr <Enter> +[list $self _Enter] |
|---|
| 580 | bind $fr <Leave> +[list $self _Leave] |
|---|
| 581 | bind $fr <ButtonPress-1> +[list $self _Hide ] |
|---|
| 582 | bind $fr <KeyPress-Escape> +[list $self _Hide ] |
|---|
| 583 | set lb [$lstBox getlb] |
|---|
| 584 | bind $lb <Double-Button-1> +[list $self _CloseList] |
|---|
| 585 | bind $lb <KeyPress-Return> +[list $self _CloseList] |
|---|
| 586 | # Bindings |
|---|
| 587 | bind $self.ek <Key-Up> +[list $self _SelectPrevious] |
|---|
| 588 | bind $self.ek <Key-Down> +[list $self _SelectNext] |
|---|
| 589 | bind $self.ek <Key-Home> +[list $self _SelectFirst] |
|---|
| 590 | bind $self.ek <Key-End> +[list $self _SelectLast] |
|---|
| 591 | bind $self.ek <Double-ButtonPress-1> [list $self _ShowList] |
|---|
| 592 | # menu |
|---|
| 593 | $self _CreateMenu |
|---|
| 594 | } |
|---|
| 595 | |
|---|
| 596 | |
|---|
| 597 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 598 | method _CreateMenu {args} { |
|---|
| 599 | # |
|---|
| 600 | # PURPOSE: Append menu to listbox. |
|---|
| 601 | # |
|---|
| 602 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 603 | install menu using menu $self.m -tearoff 0 |
|---|
| 604 | |
|---|
| 605 | $menu add command -label [mc "Select from a List"] \ |
|---|
| 606 | -command "$self _ShowList" |
|---|
| 607 | $menu add command -label [mc "Unselect all"] \ |
|---|
| 608 | -command "$self SetValueView {}" |
|---|
| 609 | $menu add command -label [mc "Copy"] \ |
|---|
| 610 | -command "$self _CopySelected 0" |
|---|
| 611 | $menu add command -label [mc "Copy all"] \ |
|---|
| 612 | -command "$self _CopySelected 1" |
|---|
| 613 | |
|---|
| 614 | $menu add command -label [mc "Search in list"] \ |
|---|
| 615 | -command "$self _FindCreate" |
|---|
| 616 | |
|---|
| 617 | |
|---|
| 618 | |
|---|
| 619 | bind $self.ek <Button-3> +[list tk_popup $menu %X %Y] |
|---|
| 620 | } |
|---|
| 621 | |
|---|
| 622 | |
|---|
| 623 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 624 | method _CopySelected { {all 0} } { |
|---|
| 625 | # |
|---|
| 626 | # PURPOSE: Copy the selected items to the clipboard |
|---|
| 627 | # |
|---|
| 628 | # PARAMETERS: all -> 1 : Copy all entrys |
|---|
| 629 | # 0 : Copy only code |
|---|
| 630 | # |
|---|
| 631 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 632 | clipboard clear |
|---|
| 633 | if {$all} { |
|---|
| 634 | set txt [$self values get] |
|---|
| 635 | } else { |
|---|
| 636 | set txt [$self values get [$self cget -colkey]] |
|---|
| 637 | } |
|---|
| 638 | clipboard append $txt |
|---|
| 639 | } |
|---|
| 640 | |
|---|
| 641 | |
|---|
| 642 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 643 | method _Init {} { |
|---|
| 644 | # |
|---|
| 645 | # PURPOSE: Method that initializes the widget. |
|---|
| 646 | # |
|---|
| 647 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 648 | global tcl_platform |
|---|
| 649 | |
|---|
| 650 | if { ($tcl_platform(platform) eq "windows") } { |
|---|
| 651 | $self _ShowList 1 |
|---|
| 652 | $self _CloseList 1 |
|---|
| 653 | } |
|---|
| 654 | } |
|---|
| 655 | |
|---|
| 656 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 657 | method _Enter { } { |
|---|
| 658 | # |
|---|
| 659 | # PURPOSE: Give value to the variable "in" when enter on frame of |
|---|
| 660 | # listboxplus. |
|---|
| 661 | # |
|---|
| 662 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 663 | set in 1 |
|---|
| 664 | } |
|---|
| 665 | |
|---|
| 666 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 667 | method _Leave { } { |
|---|
| 668 | # |
|---|
| 669 | # PURPOSE: Give value to the variable "in" when left on frame of |
|---|
| 670 | # listboxplus. |
|---|
| 671 | # |
|---|
| 672 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 673 | set in 0 |
|---|
| 674 | } |
|---|
| 675 | |
|---|
| 676 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 677 | method _ShowList { {initial 0} } { |
|---|
| 678 | # |
|---|
| 679 | # PURPOSE: Shows the selection list in a new window |
|---|
| 680 | # |
|---|
| 681 | # PARAMETERS: |
|---|
| 682 | # args -> List of options for the comboboxplus Witget |
|---|
| 683 | # |
|---|
| 684 | # TODO: |
|---|
| 685 | # Leave creation of the widget to the CreateWitget method. This method |
|---|
| 686 | # only shows, not create it. |
|---|
| 687 | # |
|---|
| 688 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 689 | # ejecutamos comando previo a la visulizacion |
|---|
| 690 | if {[string length [$self cget -postcommand] ] && $created} { |
|---|
| 691 | . configure -cursor watch |
|---|
| 692 | update |
|---|
| 693 | if {!$initial} { |
|---|
| 694 | eval [$self cget -postcommand] |
|---|
| 695 | } |
|---|
| 696 | . configure -cursor "" |
|---|
| 697 | update |
|---|
| 698 | } |
|---|
| 699 | ;# if blistboxplus hasn't items, will not do show it |
|---|
| 700 | if { $created } { |
|---|
| 701 | if {[winfo viewable $fr] == 1} { |
|---|
| 702 | wm withdraw $fr |
|---|
| 703 | grab release $fr |
|---|
| 704 | } else { |
|---|
| 705 | set vwidth [winfo reqwidth $fr] |
|---|
| 706 | set vheight [winfo reqheight $fr] |
|---|
| 707 | if {!([llength [$lstBox get]] eq 0)} { |
|---|
| 708 | wm deiconify $fr |
|---|
| 709 | #geometry |
|---|
| 710 | focus -force $fr |
|---|
| 711 | grab -global $fr |
|---|
| 712 | } |
|---|
| 713 | } |
|---|
| 714 | # Positioning the dialog |
|---|
| 715 | set posh [winfo rootx $self.ek] |
|---|
| 716 | set posv [expr [winfo rooty $self.ek]+[winfo height $self.ek]] |
|---|
| 717 | # position of the right edge of listboxplus |
|---|
| 718 | set right [expr $posh + [winfo width $fr]] |
|---|
| 719 | # position of the inferior edge of listboxplus |
|---|
| 720 | set bottom [expr $posv + [winfo height $self.ek] \ |
|---|
| 721 | + [winfo height $fr]] |
|---|
| 722 | if { $right > [winfo vrootwidth $self] } { |
|---|
| 723 | #It is necessary to change the horizontal location |
|---|
| 724 | set posh [expr [winfo rootx $self.ek] + [winfo width $self.ek] \ |
|---|
| 725 | - [winfo width $fr] ] |
|---|
| 726 | } |
|---|
| 727 | if { $bottom > [winfo vrootheight $self] } { |
|---|
| 728 | #It is necessary to change the vertical location |
|---|
| 729 | set posv [expr [winfo rooty $self.ek] - [winfo height $fr] ] |
|---|
| 730 | } |
|---|
| 731 | if {[$self cget -widthlb] eq "auto"} { |
|---|
| 732 | set width [winfo width $self.ek] |
|---|
| 733 | } else { |
|---|
| 734 | set width [$self cget -widthlb] |
|---|
| 735 | } |
|---|
| 736 | $lstBox configure -width $width |
|---|
| 737 | # Calculus of the height of blistboxplus |
|---|
| 738 | # Adjustment do not leave rows |
|---|
| 739 | set nVisibleRows [$self cget -nrows] |
|---|
| 740 | set nRows [llength [$lstBox get]] |
|---|
| 741 | if {$nRows < $nVisibleRows} { |
|---|
| 742 | set nVisibleRows $nRows |
|---|
| 743 | } |
|---|
| 744 | # Adjustment of the height of listbox with/without title |
|---|
| 745 | if {[$self cget -showtitles]} { |
|---|
| 746 | set height \ |
|---|
| 747 | [expr ($nVisibleRows * 19) + (($nVisibleRows - 1) * 2 ) + 22] |
|---|
| 748 | } else { |
|---|
| 749 | set height \ |
|---|
| 750 | [expr ($nVisibleRows * 19) + (($nVisibleRows - 1) * 2 ) + 2 ] |
|---|
| 751 | } |
|---|
| 752 | # Apply geometry |
|---|
| 753 | wm geometry $fr ${width}x$height+$posh+$posv |
|---|
| 754 | # check value previus ? |
|---|
| 755 | if {!$initial} { |
|---|
| 756 | focus [$lstBox getlb] |
|---|
| 757 | set lstPreVal [$self values get] |
|---|
| 758 | if {[string length [lindex $lstPreVal 0]]} { |
|---|
| 759 | lbOnKeyPress $lstBox \ |
|---|
| 760 | [string range [lindex $lstPreVal 0] end end] \ |
|---|
| 761 | [string range [lindex $lstPreVal 0] 0 end-1] \ |
|---|
| 762 | [clock clicks -milliseconds] 500 |
|---|
| 763 | } else { |
|---|
| 764 | set id [lindex [$lstBox get] 0] |
|---|
| 765 | # we positioned ourselves in the first element |
|---|
| 766 | if {[string length $id]} { |
|---|
| 767 | $lstBox selection set $id |
|---|
| 768 | $lstBox see $id |
|---|
| 769 | $lstBox focus $id |
|---|
| 770 | } |
|---|
| 771 | } |
|---|
| 772 | } |
|---|
| 773 | } |
|---|
| 774 | update |
|---|
| 775 | } |
|---|
| 776 | |
|---|
| 777 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 778 | method _CloseList { {initial 0} } { |
|---|
| 779 | # |
|---|
| 780 | # PURPOSE: Closes the selection list |
|---|
| 781 | # |
|---|
| 782 | # |
|---|
| 783 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 784 | wm withdraw $fr |
|---|
| 785 | grab release $fr |
|---|
| 786 | if {$in == 1 } { |
|---|
| 787 | $self _ShowSelected |
|---|
| 788 | } |
|---|
| 789 | if {[string length [$self cget -modifycmd] ] && $created } { |
|---|
| 790 | . configure -cursor watch |
|---|
| 791 | update |
|---|
| 792 | if {!$initial} { |
|---|
| 793 | eval [$self cget -modifycmd] |
|---|
| 794 | } |
|---|
| 795 | . configure -cursor "" |
|---|
| 796 | update |
|---|
| 797 | } |
|---|
| 798 | update |
|---|
| 799 | } |
|---|
| 800 | |
|---|
| 801 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 802 | method _Hide { } { |
|---|
| 803 | # |
|---|
| 804 | # PURPOSE: |
|---|
| 805 | # |
|---|
| 806 | # |
|---|
| 807 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 808 | if {$in == 0 } { |
|---|
| 809 | wm withdraw $fr |
|---|
| 810 | grab release $fr |
|---|
| 811 | } |
|---|
| 812 | } |
|---|
| 813 | |
|---|
| 814 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 815 | method _ShowSelected { } { |
|---|
| 816 | # |
|---|
| 817 | # PURPOSE: Shows in bcomboboxplus the content of the row selected in |
|---|
| 818 | # blistboxplus |
|---|
| 819 | # |
|---|
| 820 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 821 | # Recover the row selected of blistboxplus |
|---|
| 822 | set lbrow [$lstBox selection get] |
|---|
| 823 | if {$lbrow != ""} { |
|---|
| 824 | # Recover the selected values |
|---|
| 825 | set selected [$lstBox get $lbrow] |
|---|
| 826 | # Show the key value |
|---|
| 827 | $self.ek configure -text [lindex $selected [$self _PosKey]] |
|---|
| 828 | $self configure -text [lindex $selected [$self _PosKey]] |
|---|
| 829 | # Show the not hidden values |
|---|
| 830 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 831 | if {$c != [$self _PosKey]} { |
|---|
| 832 | set name [lindex [$self cget -cols ] $c] |
|---|
| 833 | $e($name) configure -text [lindex $selected $c] |
|---|
| 834 | } |
|---|
| 835 | } |
|---|
| 836 | } |
|---|
| 837 | } |
|---|
| 838 | |
|---|
| 839 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 840 | method selectIndex { index } { |
|---|
| 841 | # |
|---|
| 842 | # PURPOSE: Selects index in blistboxplus and shows the content in |
|---|
| 843 | # bcomboboxplus |
|---|
| 844 | # |
|---|
| 845 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 846 | #Index is got |
|---|
| 847 | set lbinx [$lstBox get] |
|---|
| 848 | #if the index is in the indexes list |
|---|
| 849 | if { [lsearch $lbinx $index ] != -1 } { |
|---|
| 850 | #first index |
|---|
| 851 | set first [lindex $lbinx 0] |
|---|
| 852 | #last index |
|---|
| 853 | set last [lindex $lbinx end] |
|---|
| 854 | #The previous selection is cleared |
|---|
| 855 | $lstBox selection clear $first $last |
|---|
| 856 | #And the new one is set |
|---|
| 857 | $lstBox selection set $index $index |
|---|
| 858 | $self _ShowSelected |
|---|
| 859 | } |
|---|
| 860 | } |
|---|
| 861 | |
|---|
| 862 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 863 | method selectText { text { col "" } } { |
|---|
| 864 | # |
|---|
| 865 | # PURPOSE: Selects index with the given text in the given col in blistboxplus |
|---|
| 866 | # and shows the content in bcomboboxplus |
|---|
| 867 | # PARAMETERS: text -> Text to search |
|---|
| 868 | # col -> column to search in |
|---|
| 869 | # |
|---|
| 870 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 871 | if { $col == "" } { |
|---|
| 872 | set col [$self cget -colkey] |
|---|
| 873 | } |
|---|
| 874 | foreach inx [$self get] { |
|---|
| 875 | if { [$self get $inx $col] == $text } { |
|---|
| 876 | $self selectIndex $inx |
|---|
| 877 | break |
|---|
| 878 | } |
|---|
| 879 | } |
|---|
| 880 | } |
|---|
| 881 | |
|---|
| 882 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 883 | method _SelectFirst { } { |
|---|
| 884 | # |
|---|
| 885 | # PURPOSE: Selects the first row in blistboxplus and it automatically |
|---|
| 886 | # updates it in bcomboboxplus |
|---|
| 887 | # |
|---|
| 888 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 889 | if {[$self.ek cget -text] != ""} { |
|---|
| 890 | $lstBox first |
|---|
| 891 | $self _ShowSelected |
|---|
| 892 | } |
|---|
| 893 | } |
|---|
| 894 | |
|---|
| 895 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 896 | method _SelectLast { } { |
|---|
| 897 | # |
|---|
| 898 | # PURPOSE: Selects the last row in blistboxplus and it automatically |
|---|
| 899 | # updates it in bcomboboxplus |
|---|
| 900 | # |
|---|
| 901 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 902 | if {[$self.ek cget -text] != ""} { |
|---|
| 903 | $lstBox last |
|---|
| 904 | $self _ShowSelected |
|---|
| 905 | } |
|---|
| 906 | } |
|---|
| 907 | |
|---|
| 908 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 909 | method _SelectPrevious { } { |
|---|
| 910 | # |
|---|
| 911 | # PURPOSE: Selects the previous row in blistboxplus and it automatically |
|---|
| 912 | # updates it in bcomboboxplus |
|---|
| 913 | # |
|---|
| 914 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 915 | if {[$self.ek cget -text] != ""} { |
|---|
| 916 | $lstBox previous |
|---|
| 917 | $self _ShowSelected |
|---|
| 918 | } |
|---|
| 919 | } |
|---|
| 920 | |
|---|
| 921 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 922 | method _SelectNext { } { |
|---|
| 923 | # |
|---|
| 924 | # PURPOSE: Selects the following row in blistboxplus and it automatically |
|---|
| 925 | # updates it in bcomboboxplus |
|---|
| 926 | # |
|---|
| 927 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 928 | if {[$self.ek cget -text] != ""} { |
|---|
| 929 | $lstBox next |
|---|
| 930 | $self _ShowSelected |
|---|
| 931 | } |
|---|
| 932 | } |
|---|
| 933 | |
|---|
| 934 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 935 | method key { id {value ""} } { |
|---|
| 936 | # |
|---|
| 937 | # PURPOSE: Set the value of entry of the key, get the value of entry of |
|---|
| 938 | # the key or clean this entry |
|---|
| 939 | # |
|---|
| 940 | # PARAMETERS: |
|---|
| 941 | # id -> "set" |
|---|
| 942 | # "get" |
|---|
| 943 | # "clean" |
|---|
| 944 | # value -> Value of the key for set operation |
|---|
| 945 | # |
|---|
| 946 | # RETURN: If id is "get" returns the value of the key entry |
|---|
| 947 | # |
|---|
| 948 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 949 | if { $id eq "set" } { |
|---|
| 950 | $self.ek configure -text $value |
|---|
| 951 | } else { |
|---|
| 952 | if { $id eq "get" } { |
|---|
| 953 | return [$self.ek cget -text] |
|---|
| 954 | } else { |
|---|
| 955 | if { $id eq "clean" } { |
|---|
| 956 | $self.ek configure -text "" |
|---|
| 957 | } |
|---|
| 958 | } |
|---|
| 959 | } |
|---|
| 960 | } |
|---|
| 961 | |
|---|
| 962 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 963 | method values { id {lst ""} } { |
|---|
| 964 | # |
|---|
| 965 | # PURPOSE: Set the values of the entrys (excluding the key), get or clean |
|---|
| 966 | # |
|---|
| 967 | # PARAMETERS: |
|---|
| 968 | # id -> "set" |
|---|
| 969 | # "get" |
|---|
| 970 | # "clean" |
|---|
| 971 | # lst -> List of values of the entrys for set operation |
|---|
| 972 | # |
|---|
| 973 | # RETURN: If id is "get" returns the list with values of the entrys |
|---|
| 974 | # |
|---|
| 975 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 976 | if { $id eq "set" } { |
|---|
| 977 | $self values clean |
|---|
| 978 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 979 | set name [lindex [$self cget -cols ] $c] |
|---|
| 980 | $e($name) configure -text [lindex $lst $c] |
|---|
| 981 | } |
|---|
| 982 | } else { |
|---|
| 983 | if { $id eq "get" } { |
|---|
| 984 | if {[llength $lst] eq 1} { ;# returns a value |
|---|
| 985 | set lstAux "" |
|---|
| 986 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 987 | set name [lindex [$self cget -cols ] $c] |
|---|
| 988 | if {[string compare $name $lst] eq 0} { |
|---|
| 989 | set lstAux [$e($name) cget -text] |
|---|
| 990 | } |
|---|
| 991 | } |
|---|
| 992 | if { $lstAux eq "" } { |
|---|
| 993 | set lstAux [$self.ek cget -text] |
|---|
| 994 | } |
|---|
| 995 | set lst $lstAux |
|---|
| 996 | } else { ;# returns all values |
|---|
| 997 | set lst "" |
|---|
| 998 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 999 | set name [lindex [$self cget -cols ] $c] |
|---|
| 1000 | if { [$e($name) cget -text] eq "" } { |
|---|
| 1001 | lappend lst [$self.ek cget -text] |
|---|
| 1002 | } else { |
|---|
| 1003 | lappend lst [$e($name) cget -text] |
|---|
| 1004 | } |
|---|
| 1005 | } |
|---|
| 1006 | } |
|---|
| 1007 | return $lst |
|---|
| 1008 | } else { |
|---|
| 1009 | if { $id eq "clean" } { |
|---|
| 1010 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 1011 | set name [lindex [$self cget -cols ] $c] |
|---|
| 1012 | $e($name) configure -text "" |
|---|
| 1013 | } |
|---|
| 1014 | } |
|---|
| 1015 | } |
|---|
| 1016 | } |
|---|
| 1017 | } |
|---|
| 1018 | |
|---|
| 1019 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1020 | method setEntry { name value } { |
|---|
| 1021 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1022 | if {$name eq [$self cget -colkey]} { |
|---|
| 1023 | $self.ek configure -text $value |
|---|
| 1024 | } |
|---|
| 1025 | $e($name) configure -text $value |
|---|
| 1026 | } |
|---|
| 1027 | |
|---|
| 1028 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1029 | method configureAll {opc val args} { |
|---|
| 1030 | # |
|---|
| 1031 | # PURPOSE: An option is applied all entry, including a the key |
|---|
| 1032 | # |
|---|
| 1033 | # PARAMETERS: |
|---|
| 1034 | # opc: Option to apply |
|---|
| 1035 | # val: Value associated to the option |
|---|
| 1036 | # |
|---|
| 1037 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1038 | # Values to entry of the key are introduced |
|---|
| 1039 | $self.ek configure -$opc $val |
|---|
| 1040 | # Values to the rest of entrys are introduced |
|---|
| 1041 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 1042 | set name [lindex [$self cget -cols ] $c] |
|---|
| 1043 | $e($name) configure -$opc $val |
|---|
| 1044 | } |
|---|
| 1045 | } |
|---|
| 1046 | |
|---|
| 1047 | |
|---|
| 1048 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1049 | method configureDesc {opc val args} { |
|---|
| 1050 | # |
|---|
| 1051 | # PURPOSE: We applied an option all entry, less to the key |
|---|
| 1052 | # |
|---|
| 1053 | # PARAMETERS: |
|---|
| 1054 | # opc: Option to apply |
|---|
| 1055 | # val: Value associated to the option |
|---|
| 1056 | # |
|---|
| 1057 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1058 | # Values are introduced |
|---|
| 1059 | for {set c 0} {$c<$ncols} {incr c} { |
|---|
| 1060 | set name [lindex [$self cget -cols ] $c] |
|---|
| 1061 | $e($name) configure -$opc $val |
|---|
| 1062 | } |
|---|
| 1063 | } |
|---|
| 1064 | |
|---|
| 1065 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1066 | method getEntryKey { } { |
|---|
| 1067 | # |
|---|
| 1068 | # PURPOSE: Returns the path to the entry with the key |
|---|
| 1069 | # |
|---|
| 1070 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1071 | return $self.ek |
|---|
| 1072 | } |
|---|
| 1073 | |
|---|
| 1074 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1075 | method _PosKey { } { |
|---|
| 1076 | # |
|---|
| 1077 | # PURPOSE: Devuelve la posicion en la que se encuentra la clave dentro de |
|---|
| 1078 | # la lista de columnas del bcomboboxplus |
|---|
| 1079 | # |
|---|
| 1080 | # RETURNS: |
|---|
| 1081 | # Devuelve la posicion en la que se encuentra la clave |
|---|
| 1082 | # |
|---|
| 1083 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1084 | return [lsearch -glob [$self cget -cols] [$self cget -colkey]] |
|---|
| 1085 | } |
|---|
| 1086 | |
|---|
| 1087 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1088 | method activate {stt args} { |
|---|
| 1089 | # |
|---|
| 1090 | # PURPOSE: Aplicamos una opción a los elemetos del componente. Por un lado |
|---|
| 1091 | # al entry del código, al botón y al resto de campos entry. |
|---|
| 1092 | # |
|---|
| 1093 | # PARAMETERS: |
|---|
| 1094 | # stt: opción a aplicar |
|---|
| 1095 | # normal -> Code (yes) Button (no) Desc (no) |
|---|
| 1096 | # active -> Code (yes) Button (no) Desc (yes) |
|---|
| 1097 | # select -> Code (no) Button (yes) Desc (no) |
|---|
| 1098 | # disabled -> Code (no) Button (no) Desc (yes) |
|---|
| 1099 | # notactive -> Code (no) Button (no) Desc (no) |
|---|
| 1100 | # allactive -> Code (yes) Button (yes) Desc (yes) |
|---|
| 1101 | # descnoedit-> Code (yes) Button (yes) Desc (not editable) |
|---|
| 1102 | # |
|---|
| 1103 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1104 | # introducimos valores |
|---|
| 1105 | switch $stt { |
|---|
| 1106 | "normal" { |
|---|
| 1107 | BfoActivateWidget $self.ek $stt |
|---|
| 1108 | $self.ek configure -editable true |
|---|
| 1109 | BfoActivateWidget $self.ab "disabled" |
|---|
| 1110 | $self configureDesc state disabled |
|---|
| 1111 | $self configureDesc editable false |
|---|
| 1112 | bind $self.ek <Double-ButtonPress-1> [list $self _ShowList] |
|---|
| 1113 | } |
|---|
| 1114 | "active" { |
|---|
| 1115 | BfoActivateWidget $self.ek "normal" |
|---|
| 1116 | $self.ek configure -editable true |
|---|
| 1117 | BfoActivateWidget $self.ab "disabled" |
|---|
| 1118 | $self configureDesc state normal |
|---|
| 1119 | $self configureDesc editable true |
|---|
| 1120 | bind $self.ek <Double-ButtonPress-1> [list $self _ShowList] |
|---|
| 1121 | } |
|---|
| 1122 | "select" { |
|---|
| 1123 | BfoActivateWidget $self.ek "disabled" |
|---|
| 1124 | $self.ek configure -editable false |
|---|
| 1125 | BfoActivateWidget $self.ab "active" |
|---|
| 1126 | $self configureDesc state normal |
|---|
| 1127 | $self configureDesc editable false |
|---|
| 1128 | bind $self.ek <Double-ButtonPress-1> {} |
|---|
| 1129 | } |
|---|
| 1130 | "disabled" { |
|---|
| 1131 | BfoActivateWidget $self.ek "disabled" |
|---|
| 1132 | $self.ek configure -editable false |
|---|
| 1133 | BfoActivateWidget $self.ab "disabled" |
|---|
| 1134 | $self configureDesc state normal |
|---|
| 1135 | $self configureDesc editable true |
|---|
| 1136 | bind $self.ek <Double-ButtonPress-1> {} |
|---|
| 1137 | } |
|---|
| 1138 | "notactive" { |
|---|
| 1139 | BfoActivateWidget $self.ek "disabled" |
|---|
| 1140 | $self.ek configure -editable false |
|---|
| 1141 | BfoActivateWidget $self.ab "disabled" |
|---|
| 1142 | $self configureDesc state normal |
|---|
| 1143 | $self configureDesc editable false |
|---|
| 1144 | bind $self.ek <Double-ButtonPress-1> {} |
|---|
| 1145 | } |
|---|
| 1146 | "allactive" { |
|---|
| 1147 | BfoActivateWidget $self.ek "normal" |
|---|
| 1148 | $self.ek configure -editable true |
|---|
| 1149 | $self configureDesc state normal |
|---|
| 1150 | eval BfoActivateWidget $self.ab active |
|---|
| 1151 | $self configureDesc editable true |
|---|
| 1152 | bind $self.ek <Double-ButtonPress-1> [list $self _ShowList] |
|---|
| 1153 | } |
|---|
| 1154 | "descnoedit" { |
|---|
| 1155 | BfoActivateWidget $self.ek "normal" |
|---|
| 1156 | $self.ek configure -editable true |
|---|
| 1157 | $self configureDesc state normal |
|---|
| 1158 | eval BfoActivateWidget $self.ab active |
|---|
| 1159 | $self configureDesc editable false |
|---|
| 1160 | bind $self.ek <Double-ButtonPress-1> [list $self _ShowList] |
|---|
| 1161 | } |
|---|
| 1162 | default { |
|---|
| 1163 | puts "BComboboxPlus Activate ERROR: invalid state: $stt" |
|---|
| 1164 | } |
|---|
| 1165 | } |
|---|
| 1166 | } |
|---|
| 1167 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1168 | method getwidget {} { |
|---|
| 1169 | # |
|---|
| 1170 | # PURPOSE: Obtenemos el nombre de todos los objetos creados |
|---|
| 1171 | # |
|---|
| 1172 | # PARAMETERS: lista con el path de los entrys creados |
|---|
| 1173 | # |
|---|
| 1174 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1175 | return $blstentry |
|---|
| 1176 | } |
|---|
| 1177 | |
|---|
| 1178 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1179 | method SetValueView {lst args} { |
|---|
| 1180 | # |
|---|
| 1181 | # PURPOSE: Insertamos los valores en los entrys |
|---|
| 1182 | # |
|---|
| 1183 | # PARAMETERS: args -> lista con los valores a incluir, el primero es el del |
|---|
| 1184 | # codigo |
|---|
| 1185 | # |
|---|
| 1186 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 1187 | # limpiamos valores visualizados |
|---|
| 1188 | $self values clean |
|---|
| 1189 | # introducuimos valores |
|---|
| 1190 | set i 0 |
|---|
| 1191 | foreach obj $blstentry { |
|---|
| 1192 | set current [$obj cget -state] |
|---|
| 1193 | $obj configure -state normal |
|---|
| 1194 | $obj configure -text [lindex $lst $i] |
|---|
| 1195 | $obj configure -state $current |
|---|
| 1196 | incr i |
|---|
| 1197 | } |
|---|
| 1198 | } |
|---|
| 1199 | |
|---|
| 1200 | |
|---|
| 1201 | |
|---|
| 1202 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1203 | method _FindCreate { } { |
|---|
| 1204 | # |
|---|
| 1205 | # PURPOSE: Creates a Find Dialog given a Instance |
|---|
| 1206 | # |
|---|
| 1207 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1208 | #upvar \#0 ${Instance}::data data |
|---|
| 1209 | |
|---|
| 1210 | set dialog [Dialog $self.dg -title [mc "Find"]\ |
|---|
| 1211 | -default 0 -modal none -parent $self] |
|---|
| 1212 | wm protocol $dialog WM_DELETE_WINDOW \ |
|---|
| 1213 | [list $self _FindDestroy $dialog] |
|---|
| 1214 | set w [$dialog getframe] |
|---|
| 1215 | wm resizable $self.dg 0 0 |
|---|
| 1216 | |
|---|
| 1217 | set data(frm,cad) [LabelEntry $w.eTxt -label "[mc "Find"]: " \ |
|---|
| 1218 | -textvariable data($self,find,text)] |
|---|
| 1219 | checkbutton $w.case -text [mc "Case sensitive"] \ |
|---|
| 1220 | -variable data($self,find,case) -pady 0 |
|---|
| 1221 | TitleFrame $w.dir -bd 2 -relief groove -text [mc "Direction"] |
|---|
| 1222 | set f [$w.dir getframe] |
|---|
| 1223 | radiobutton $f.forward -text [mc "Forward"] -value forward \ |
|---|
| 1224 | -variable [varname data(find,dirbusqueda)] \ |
|---|
| 1225 | -highlightthickness 0 -pady 0 |
|---|
| 1226 | radiobutton $f.backward -text [mc "Backward"] -value backward \ |
|---|
| 1227 | -variable [varname data(find,dirbusqueda)] \ |
|---|
| 1228 | -highlightthickness 0 -pady 0 |
|---|
| 1229 | Button $w.findNext -text [mc "Find next"] -width 16 \ |
|---|
| 1230 | -command [list $self _FindNext] \ |
|---|
| 1231 | -helptext [mc "Find next"] |
|---|
| 1232 | Button $w.cancelar -text [mc "Cancel"] -width 16 -helptext "" \ |
|---|
| 1233 | -command [list $self _FindDestroy $dialog] |
|---|
| 1234 | |
|---|
| 1235 | bind $dialog <Return> [list $self _FindNext] |
|---|
| 1236 | bind $dialog <F3> [list $self _FindNext] |
|---|
| 1237 | bind $dialog <Escape> [list $self _FindDestroy $dialog] |
|---|
| 1238 | |
|---|
| 1239 | # Hemos añadido un tag para la selección, hay que quitarle como el tag sel |
|---|
| 1240 | #bind $data(editor) <ButtonPress> +[list $data(editor) tag delete found] |
|---|
| 1241 | |
|---|
| 1242 | grid $f.forward $f.backward -sticky nw |
|---|
| 1243 | |
|---|
| 1244 | grid $w.eTxt - $w.findNext -sticky news -padx 5 -pady 2 |
|---|
| 1245 | grid $w.case $w.dir $w.cancelar -sticky new -padx 5 |
|---|
| 1246 | |
|---|
| 1247 | grid columnconfigure $w 0 -weight 1 |
|---|
| 1248 | grid columnconfigure $w 1 -weight 0 |
|---|
| 1249 | grid rowconfigure $w 0 -weight 0 |
|---|
| 1250 | grid rowconfigure $w 1 -weight 0 |
|---|
| 1251 | grid rowconfigure $w 2 -weight 0 |
|---|
| 1252 | grid rowconfigure $w 10 -weight 1 |
|---|
| 1253 | |
|---|
| 1254 | wm geometry $dialog 360x90 |
|---|
| 1255 | $dialog draw |
|---|
| 1256 | update |
|---|
| 1257 | focus $data(frm,cad) |
|---|
| 1258 | $data(frm,cad).e selection range 0 end |
|---|
| 1259 | } |
|---|
| 1260 | |
|---|
| 1261 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1262 | method _FindNext { } { |
|---|
| 1263 | # |
|---|
| 1264 | # PURPOSE: Make the next find in editor |
|---|
| 1265 | # |
|---|
| 1266 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1267 | # Coger la posición actual del cursor en el text y buscar desde ahí, |
|---|
| 1268 | variable data |
|---|
| 1269 | |
|---|
| 1270 | #dg.frame.eTxt.e |
|---|
| 1271 | set entryBus $self.dg.frame.eTxt.e |
|---|
| 1272 | |
|---|
| 1273 | #set lstPreVal {} |
|---|
| 1274 | #set idxFind {} |
|---|
| 1275 | set data($self,indices) [$self entry children root] |
|---|
| 1276 | set auxVal "*[$entryBus cget -text]*" |
|---|
| 1277 | |
|---|
| 1278 | Tolcon_Trace "valBusqueda --> $valBusqueda" |
|---|
| 1279 | Tolcon_Trace "valor aux --> $auxVal" |
|---|
| 1280 | |
|---|
| 1281 | if {$valBusqueda == ""} { |
|---|
| 1282 | Tolcon_Trace "LIMPIO VARIABLES 1" |
|---|
| 1283 | set lstPreVal {} |
|---|
| 1284 | set idxFind {} |
|---|
| 1285 | set vez 0 |
|---|
| 1286 | set data($self,valBusqueda) *[$entryBus cget -text]* |
|---|
| 1287 | set valBusqueda $data($self,valBusqueda) |
|---|
| 1288 | } else { |
|---|
| 1289 | if {$valBusqueda != $auxVal} { |
|---|
| 1290 | Tolcon_Trace "LIMPIO VARIABLES 2" |
|---|
| 1291 | set lstPreVal {} |
|---|
| 1292 | set idxFind {} |
|---|
| 1293 | set vez 0 |
|---|
| 1294 | set data($self,valBusqueda) $auxVal |
|---|
| 1295 | } |
|---|
| 1296 | } |
|---|
| 1297 | |
|---|
| 1298 | if {[llength $data($self,indices)]} { |
|---|
| 1299 | foreach idx $data($self,indices) { |
|---|
| 1300 | lappend lstPreVal [$self entry cget $idx -data] |
|---|
| 1301 | } |
|---|
| 1302 | } |
|---|
| 1303 | |
|---|
| 1304 | Tolcon_Trace "Direccion de búsqueda -> $data(find,dirbusqueda)" |
|---|
| 1305 | #Tolcon_Trace "LISTA --> $lstPreVal" |
|---|
| 1306 | Tolcon_Trace "combobox -> $self" |
|---|
| 1307 | #Tolcon_Trace "lstBox -> $lstBox" |
|---|
| 1308 | #Tolcon_Trace "indices -> $data($self,indices)" |
|---|
| 1309 | #Tolcon_Trace "Valor Buscado -> $data($self,valBusqueda)" |
|---|
| 1310 | Tolcon_Trace "VEZ -> $vez" |
|---|
| 1311 | |
|---|
| 1312 | if {[llength $lstPreVal]} { |
|---|
| 1313 | set pos 1 |
|---|
| 1314 | if {![llength $idxFind]} { |
|---|
| 1315 | Tolcon_Trace "BUSCO" |
|---|
| 1316 | foreach elem $lstPreVal { |
|---|
| 1317 | set aux [lsearch $elem $data($self,valBusqueda)] |
|---|
| 1318 | if {$aux != -1} { |
|---|
| 1319 | Tolcon_Trace "Encontrado en pos -> $pos" |
|---|
| 1320 | lappend idxFind $pos |
|---|
| 1321 | } |
|---|
| 1322 | incr pos 1 |
|---|
| 1323 | } |
|---|
| 1324 | } |
|---|
| 1325 | Tolcon_Trace "LISTA DE POSICIONES ENCONTRADAS --> $idxFind" |
|---|
| 1326 | if {[llength $idxFind]} { |
|---|
| 1327 | set ok 1 |
|---|
| 1328 | Tolcon_Trace "Valor -> $idxFind" |
|---|
| 1329 | Tolcon_Trace "Tamaño lista -> [llength $idxFind]" |
|---|
| 1330 | $self selection clear 0 end |
|---|
| 1331 | if {[llength $idxFind] == 1} { |
|---|
| 1332 | Tolcon_Trace "IF" |
|---|
| 1333 | Tolcon_Trace "INTENTO POSICIONAR EL CURSOR -> [lindex $idxFind 0]" |
|---|
| 1334 | $self selectIndex [lindex $idxFind 0] |
|---|
| 1335 | } else { |
|---|
| 1336 | Tolcon_Trace "ELSE" |
|---|
| 1337 | if {$vez < [llength $idxFind]} { |
|---|
| 1338 | Tolcon_Trace "INTENTO POSICIONAR EL CURSOR -> [lindex $idxFind $vez]" |
|---|
| 1339 | $self selectIndex [lindex $idxFind $vez] |
|---|
| 1340 | } else { |
|---|
| 1341 | set rq \ |
|---|
| 1342 | [tk_messageBox -type yesno -icon question \ |
|---|
| 1343 | -title [mc "Confirmation. Restart search"] \ |
|---|
| 1344 | -parent $entryBus \ |
|---|
| 1345 | -message [mc "You have arrived to the end of list. Do you want to restart search?"]] |
|---|
| 1346 | |
|---|
| 1347 | if {[string equal $rq yes]} { |
|---|
| 1348 | set vez 0 |
|---|
| 1349 | $self selection clear 0 end |
|---|
| 1350 | set lstPreVal {} |
|---|
| 1351 | set idxFind {} |
|---|
| 1352 | $self _FindNext |
|---|
| 1353 | return |
|---|
| 1354 | } |
|---|
| 1355 | } |
|---|
| 1356 | } |
|---|
| 1357 | } else { |
|---|
| 1358 | set msg [mc {No coincidence was found in list}] |
|---|
| 1359 | ShowMessage W $msg $self |
|---|
| 1360 | set ok 0 |
|---|
| 1361 | } |
|---|
| 1362 | } else { |
|---|
| 1363 | set msg [mc {No coincidence was found in list}] |
|---|
| 1364 | ShowMessage W $msg $self |
|---|
| 1365 | set ok 0 |
|---|
| 1366 | } |
|---|
| 1367 | |
|---|
| 1368 | incr vez 1 |
|---|
| 1369 | } |
|---|
| 1370 | |
|---|
| 1371 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1372 | method _FindDestroy {dialog} { |
|---|
| 1373 | # |
|---|
| 1374 | # PURPOSE: Replace text in editor |
|---|
| 1375 | # |
|---|
| 1376 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1377 | variable options |
|---|
| 1378 | |
|---|
| 1379 | #upvar \#0 ${Instance}::data data |
|---|
| 1380 | # inizialization values |
|---|
| 1381 | #set options(find,dir) $data(find,dir) |
|---|
| 1382 | #set options(find,case) $data(find,case) |
|---|
| 1383 | |
|---|
| 1384 | # destroy |
|---|
| 1385 | set vez 0 |
|---|
| 1386 | set entryBus $self.dg.frame.eTxt.e |
|---|
| 1387 | $entryBus configure -text "" |
|---|
| 1388 | |
|---|
| 1389 | destroy $dialog |
|---|
| 1390 | } |
|---|
| 1391 | |
|---|
| 1392 | |
|---|
| 1393 | |
|---|
| 1394 | |
|---|
| 1395 | |
|---|
| 1396 | # delegation of methods and options |
|---|
| 1397 | delegate method * to lstBox |
|---|
| 1398 | delegate option * to lstBox |
|---|
| 1399 | } |
|---|
| 1400 | |
|---|
| 1401 | |
|---|
| 1402 | |
|---|
| 1403 | |
|---|
| 1404 | |
|---|
| 1405 | |
|---|
| 1406 | package provide bcomboboxplus 1.0 |
|---|
| 1407 | |
|---|
| 1408 | |
|---|
| 1409 | # ------- TEST CODE ---- |
|---|
| 1410 | |
|---|
| 1411 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1412 | proc test_bcomboboxplus {} { |
|---|
| 1413 | # |
|---|
| 1414 | # PURPOSE: Test function bcomboboxplus |
|---|
| 1415 | # |
|---|
| 1416 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1417 | |
|---|
| 1418 | # defining the widgets |
|---|
| 1419 | namespace eval test_bcomboboxplus { |
|---|
| 1420 | variable var |
|---|
| 1421 | } |
|---|
| 1422 | set ::var "" |
|---|
| 1423 | destroy .top |
|---|
| 1424 | toplevel .top |
|---|
| 1425 | # key column |
|---|
| 1426 | set cc "c2" |
|---|
| 1427 | # all columns |
|---|
| 1428 | set ca "c1 c2 c3 c4 c5 c6" |
|---|
| 1429 | # hidden columns |
|---|
| 1430 | set ch "c4" |
|---|
| 1431 | # labels of bcomboboxplus |
|---|
| 1432 | set clsf { {Label1} {Label 2} {Label 3} {Label 4} {Label 5} {Label 6} } |
|---|
| 1433 | # showlabels in bcomboboxplus |
|---|
| 1434 | set sl 0 |
|---|
| 1435 | set slk 0 |
|---|
| 1436 | # width of fields |
|---|
| 1437 | set wdh "10 15 5 5 10 15" |
|---|
| 1438 | # blistboxplus content |
|---|
| 1439 | set lbc "{1 2 3 4 5 6} {one two three four five six} \ |
|---|
| 1440 | {uno dos tres cuatro cinco seis} \ |
|---|
| 1441 | {k kk kkk kkkk kkkkk kkkkkk} {0 0 0 0 0 0} {@ # $ % | ?}" |
|---|
| 1442 | # visible columns of blistboxplus |
|---|
| 1443 | set cvLb "c1 c2 c3 c4" |
|---|
| 1444 | # hidden columns of blistboxplus |
|---|
| 1445 | set chLb "c5 c6" |
|---|
| 1446 | # number of rows of blistboxplus |
|---|
| 1447 | set lbr 5 |
|---|
| 1448 | # helptextkey |
|---|
| 1449 | set htk "helptext del campo clave" |
|---|
| 1450 | # helptexts |
|---|
| 1451 | set hts { {help c1} {help c2} {help c3} {help c4} {help c5} {help c6} } |
|---|
| 1452 | TitleFrame .top.f1 -text "BComboboxPlus test" |
|---|
| 1453 | set f1 [ .top.f1 getframe ] |
|---|
| 1454 | append tl $cvLb " " $chLb |
|---|
| 1455 | |
|---|
| 1456 | # Create bcomboboxplus |
|---|
| 1457 | set bcbp [bcomboboxplus $f1.bsf -cols $ca -keyhelptext $htk -helptexts $hts \ |
|---|
| 1458 | -color "Blue" -width $wdh -parent $f1 \ |
|---|
| 1459 | -titles $clsf -showlabels $sl -showlabelkey $slk \ |
|---|
| 1460 | -hiddencolslb $chLb -hiddencols $ch -colslb $tl \ |
|---|
| 1461 | -colkey $cc -variable "::test_bcomboboxplus::var" -varcol "c1"\ |
|---|
| 1462 | -modifycmd [list puts "executing modifycmd"] \ |
|---|
| 1463 | -postcommand [list puts "executing postcommand"] ] |
|---|
| 1464 | # insert values in blistboxplus on bcomboboxplus |
|---|
| 1465 | eval $f1.bsf insert end $lbc |
|---|
| 1466 | # Create frames |
|---|
| 1467 | TitleFrame .top.f2 -text [mc "Configure"] |
|---|
| 1468 | set f2 [ .top.f2 getframe ] |
|---|
| 1469 | TitleFrame $f2.f21 -text [mc "Combobox Plus"] |
|---|
| 1470 | set f21 [ $f2.f21 getframe ] |
|---|
| 1471 | LabelFrame $f21.f211 |
|---|
| 1472 | set f211 [ $f21.f211 getframe ] |
|---|
| 1473 | TitleFrame $f2.f22 -text [mc "List Box"] |
|---|
| 1474 | set f22 [ $f2.f22 getframe ] |
|---|
| 1475 | # Test comboboxplus |
|---|
| 1476 | Label $f21.lf -text [mc "Labels"] |
|---|
| 1477 | Label $f21.lc -text [mc "Key column"] |
|---|
| 1478 | Label $f21.lv -text [mc "Columns"] |
|---|
| 1479 | Label $f21.lh -text [mc "Hidden columns"] |
|---|
| 1480 | Label $f21.lwdh -text [mc "Width of fields"] |
|---|
| 1481 | Entry $f21.ef -width 30 -text $clsf |
|---|
| 1482 | Entry $f21.ec -width 5 -text $cc |
|---|
| 1483 | Entry $f21.ev -width 20 -text $ca |
|---|
| 1484 | Entry $f21.eh -width 20 -text $ch |
|---|
| 1485 | Entry $f21.ewdh -width 5 -text $wdh |
|---|
| 1486 | # variables associated to each checkbutton and buttons |
|---|
| 1487 | set ::varCbkl 0 |
|---|
| 1488 | set ::varCb 0 |
|---|
| 1489 | checkbutton $f211.cblk -text [mc "Show label key"] \ |
|---|
| 1490 | -command { toggleShowLabelKey } -variable ::varCblk |
|---|
| 1491 | checkbutton $f211.cb -text [mc "Show labels"] \ |
|---|
| 1492 | -command { toggleShowLabels } -variable ::varCb |
|---|
| 1493 | button $f211.bi -text [mc "Apply"] -command { applyCmd } -width 20 |
|---|
| 1494 | # Test listbox |
|---|
| 1495 | Label $f22.lcn -text [mc "Content"] |
|---|
| 1496 | Label $f22.lf -text [mc "Titles"] |
|---|
| 1497 | Label $f22.lh -text [mc "Hidden columns"] |
|---|
| 1498 | Label $f22.lr -text [mc "Number of rows"] |
|---|
| 1499 | Entry $f22.ecn -text $lbc |
|---|
| 1500 | Entry $f22.eh -width 20 -text $chLb |
|---|
| 1501 | Entry $f22.er -text $lbr |
|---|
| 1502 | set ::varTlb 1 |
|---|
| 1503 | checkbutton $f22.cblb -text [mc "Show titles"] \ |
|---|
| 1504 | -command { toggleShowTitles } -variable ::varTlb |
|---|
| 1505 | button $f22.bd -text [mc "Apply"] -command { applyLbCmd } -width 20 |
|---|
| 1506 | # packing all |
|---|
| 1507 | grid .top.f1 -row 0 -column 0 -sticky news -padx 10 -pady 10 |
|---|
| 1508 | grid .top.f2 -row 1 -column 0 -sticky news -padx 10 -pady 10 |
|---|
| 1509 | grid columnconfigure .top 0 -weight 1 |
|---|
| 1510 | grid rowconfigure .top 0 -weight 0 |
|---|
| 1511 | grid rowconfigure .top 1 -weight 1 |
|---|
| 1512 | grid $f1.bsf -row 0 -column 0 -sticky "news" |
|---|
| 1513 | grid columnconfigure $f1 0 -weight 1 |
|---|
| 1514 | grid rowconfigure $f1 0 -weight 1 |
|---|
| 1515 | grid $f2.f21 -row 0 -column 0 -sticky news -padx 10 -pady 10 |
|---|
| 1516 | grid $f2.f22 -row 0 -column 1 -sticky news -padx 10 -pady 10 |
|---|
| 1517 | grid $f21.f211 -row 10 -column 0 -sticky news -columnspan 2 |
|---|
| 1518 | grid $f21.lc -row 0 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1519 | grid $f21.lv -row 1 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1520 | grid $f21.lh -row 2 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1521 | grid $f21.lf -row 3 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1522 | grid $f21.lwdh -row 4 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1523 | grid $f21.ec -row 0 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1524 | grid $f21.ev -row 1 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1525 | grid $f21.eh -row 2 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1526 | grid $f21.ef -row 3 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1527 | grid $f21.ewdh -row 4 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1528 | grid $f211.cblk -row 1 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1529 | grid $f211.cb -row 1 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1530 | grid $f211.bi -row 1 -column 2 -sticky "news" -padx 10 -pady 2 |
|---|
| 1531 | grid $f22.lcn -row 1 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1532 | grid $f22.lh -row 3 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1533 | grid $f22.lr -row 4 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1534 | grid $f22.ecn -row 1 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1535 | grid $f22.eh -row 3 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1536 | grid $f22.er -row 4 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1537 | grid $f22.bd -row 5 -column 1 -sticky "news" -padx 10 -pady 2 |
|---|
| 1538 | grid $f22.cblb -row 5 -column 0 -sticky "news" -padx 10 -pady 2 |
|---|
| 1539 | |
|---|
| 1540 | proc applyCmd {} { |
|---|
| 1541 | .top.f1.f.bsf configure -titles [.top.f2.f.f21.f.ef cget -text] |
|---|
| 1542 | .top.f1.f.bsf configure -hiddencols [.top.f2.f.f21.f.eh cget -text] |
|---|
| 1543 | .top.f1.f.bsf configure -colkey [.top.f2.f.f21.f.ec cget -text] |
|---|
| 1544 | .top.f1.f.bsf configure -width [.top.f2.f.f21.f.ewdh cget -text] |
|---|
| 1545 | } |
|---|
| 1546 | |
|---|
| 1547 | proc applyLbCmd {} { |
|---|
| 1548 | .top.f1.f.bsf clear |
|---|
| 1549 | eval .top.f1.f.bsf insert end [.top.f2.f.f22.f.ecn cget -text] |
|---|
| 1550 | .top.f1.f.bsf configure -colslb [.top.f2.f.f21.f.ev cget -text] |
|---|
| 1551 | .top.f1.f.bsf configure -hiddencolslb [.top.f2.f.f22.f.eh cget -text] |
|---|
| 1552 | .top.f1.f.bsf configure -nrows [.top.f2.f.f22.f.er cget -text] |
|---|
| 1553 | } |
|---|
| 1554 | |
|---|
| 1555 | proc toggleShowLabels {} { |
|---|
| 1556 | if { [.top.f1.f.bsf cget -showlabels] } { |
|---|
| 1557 | .top.f1.f.bsf configure -showlabels 0 |
|---|
| 1558 | } else { |
|---|
| 1559 | .top.f1.f.bsf configure -showlabels 1 |
|---|
| 1560 | } |
|---|
| 1561 | } |
|---|
| 1562 | |
|---|
| 1563 | proc toggleShowLabelKey {} { |
|---|
| 1564 | if { [.top.f1.f.bsf cget -showlabelkey] } { |
|---|
| 1565 | .top.f1.f.bsf configure -showlabelkey 0 |
|---|
| 1566 | } else { |
|---|
| 1567 | .top.f1.f.bsf configure -showlabelkey 1 |
|---|
| 1568 | } |
|---|
| 1569 | } |
|---|
| 1570 | |
|---|
| 1571 | proc toggleShowTitles {} { |
|---|
| 1572 | if { [.top.f1.f.bsf cget -showtitles] } { |
|---|
| 1573 | .top.f1.f.bsf configure -showtitles false |
|---|
| 1574 | } else { |
|---|
| 1575 | .top.f1.f.bsf configure -showtitles true |
|---|
| 1576 | } |
|---|
| 1577 | } |
|---|
| 1578 | } |
|---|
