| 1 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2 | # FILE : bselectfields.tcl |
|---|
| 3 | # PURPOSE : Select Fields. Componente que nos permite seleccionar un elemento |
|---|
| 4 | # mostrandonos una lista con toda la informacion que le indiquemos. |
|---|
| 5 | # El resultado obtenido le divide en 1+n partes, una para el codigo |
|---|
| 6 | # y n para campos que deseemos mostrar. n puede valar cero. |
|---|
| 7 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 8 | |
|---|
| 9 | # includes |
|---|
| 10 | if {0} { |
|---|
| 11 | package require Tk |
|---|
| 12 | package require snit 0.81 |
|---|
| 13 | package require BWidget |
|---|
| 14 | |
|---|
| 15 | package require msgcat |
|---|
| 16 | namespace import msgcat::* |
|---|
| 17 | |
|---|
| 18 | |
|---|
| 19 | source ini_byswidget.tcl |
|---|
| 20 | source ./../toltk/mclistbox.tcl |
|---|
| 21 | |
|---|
| 22 | } |
|---|
| 23 | |
|---|
| 24 | package require byscommon |
|---|
| 25 | |
|---|
| 26 | |
|---|
| 27 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 28 | ::snit::widget bselectfields { |
|---|
| 29 | # |
|---|
| 30 | # PURPOSE: Defincición de las funcionalidades de un BayesSelectFields |
|---|
| 31 | # |
|---|
| 32 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 33 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 34 | # options: |
|---|
| 35 | # -blstfields -> Lista de campos a mostar. El primero es el codigo |
|---|
| 36 | # -blsthelptexts -> Lista de helptext que se muestran cuando se pasa el |
|---|
| 37 | # raton por encima de los 'entries' (o labelentries) |
|---|
| 38 | # -bvalues -> lista con los valores a mostrar para la seleccion |
|---|
| 39 | # (los datos que se insertan en el listbox desplegable) |
|---|
| 40 | # -btitle -> nombre a asignar a las columnas para la selecion |
|---|
| 41 | # -bmodifycmd -> comando a ejecutar despues de seleccionar un item |
|---|
| 42 | # -bpostcommand -> comando a ejecutar antes de mostrar la lista |
|---|
| 43 | # -label -> Texto de encabezado del campo. Si no se especifica, se deja |
|---|
| 44 | # en blanco. |
|---|
| 45 | # -labeldesc -> Booleano para etiquetar o no las descripciones. |
|---|
| 46 | # -color -> Color para las etiquetas (red, blue, etc.). |
|---|
| 47 | # -width -> Anchura de los entries. |
|---|
| 48 | # |
|---|
| 49 | # variable |
|---|
| 50 | # blstfields -> lista de campos a visualizar |
|---|
| 51 | # blstvalues -> lista de valores a mostrar para la seleccion |
|---|
| 52 | # blsttitlecol -> lista de titulos de las columnas a mostrar |
|---|
| 53 | # blstentry -> lista de objetos entry visualizados |
|---|
| 54 | # blstcolumns -> lista de listbox visualizados en la seleccion |
|---|
| 55 | # bmodifycmd -> comando a aplicar al aceptar |
|---|
| 56 | # bpostcommand -> comando a ejecutar antes de mostrar la lista |
|---|
| 57 | # |
|---|
| 58 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 59 | widgetclass BSelectFields |
|---|
| 60 | |
|---|
| 61 | option -blstfields "" |
|---|
| 62 | option -blsthelptexts "" |
|---|
| 63 | option -bvalues "" |
|---|
| 64 | option -btitle "" |
|---|
| 65 | option -bmodifycmd "" |
|---|
| 66 | option -bpostcommand "" |
|---|
| 67 | option -label "" |
|---|
| 68 | option -labeldesc false |
|---|
| 69 | option -color "black" |
|---|
| 70 | option -width 20 |
|---|
| 71 | |
|---|
| 72 | variable blstfields |
|---|
| 73 | variable blsthelptexts |
|---|
| 74 | variable blstvalues |
|---|
| 75 | variable blsttitlecol |
|---|
| 76 | variable blstentry |
|---|
| 77 | variable blstcolumns |
|---|
| 78 | variable bmodifycmd |
|---|
| 79 | variable bpostcommand |
|---|
| 80 | variable blabel |
|---|
| 81 | variable bcolor |
|---|
| 82 | variable blabdesc |
|---|
| 83 | variable width |
|---|
| 84 | variable data |
|---|
| 85 | |
|---|
| 86 | |
|---|
| 87 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 88 | constructor {args} { |
|---|
| 89 | # |
|---|
| 90 | # PURPOSE: bselectfields constructor |
|---|
| 91 | # |
|---|
| 92 | # PARAMETERS: |
|---|
| 93 | # args -> |
|---|
| 94 | # |
|---|
| 95 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 96 | set blstvalues $options(-bvalues) |
|---|
| 97 | # Apply all options passed at creation time. |
|---|
| 98 | $self configurelist $args |
|---|
| 99 | #set parent $options(-parent) |
|---|
| 100 | set blstfields $options(-blstfields) |
|---|
| 101 | set blsthelptexts $options(-blsthelptexts) |
|---|
| 102 | |
|---|
| 103 | set blsttitlecol $options(-btitle) |
|---|
| 104 | set bmodifycmd $options(-bmodifycmd) |
|---|
| 105 | set bpostcommand $options(-bpostcommand) |
|---|
| 106 | set blabel $options(-label) |
|---|
| 107 | set blabdesc $options(-labeldesc) |
|---|
| 108 | set bcolor $options(-color) |
|---|
| 109 | set width $options(-width) |
|---|
| 110 | # Apply all options passed at creation time. |
|---|
| 111 | #$self configurelist $args |
|---|
| 112 | $self CreateWidgets |
|---|
| 113 | } |
|---|
| 114 | |
|---|
| 115 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 116 | onconfigure -bvalues {lst} { |
|---|
| 117 | # |
|---|
| 118 | # PURPOSE: Change list values of bselectfields. |
|---|
| 119 | # Use '$widget configure -bvalues $lst' instead of 'SetLstValues' |
|---|
| 120 | # |
|---|
| 121 | # PARAMETERS: |
|---|
| 122 | # lst: List with new values |
|---|
| 123 | # |
|---|
| 124 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 125 | set blstvalues $lst |
|---|
| 126 | } |
|---|
| 127 | |
|---|
| 128 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 129 | onconfigure -width {value} { |
|---|
| 130 | # |
|---|
| 131 | # PURPOSE: Change all entries' width when configure -width is called. |
|---|
| 132 | # |
|---|
| 133 | # PARAMETERS: |
|---|
| 134 | # value: Width at wich all entries will be adjusted. |
|---|
| 135 | # |
|---|
| 136 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 137 | if {0} { |
|---|
| 138 | #Change the code width: |
|---|
| 139 | $self.f.eCode configure -width $value |
|---|
| 140 | #Change all field's width: |
|---|
| 141 | for {set x 1} {$x < [llength $blstfields]} {incr x} { |
|---|
| 142 | $self.f.eCode configure -width $value |
|---|
| 143 | } |
|---|
| 144 | } |
|---|
| 145 | } |
|---|
| 146 | |
|---|
| 147 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 148 | method CreateWidgets {args} { |
|---|
| 149 | # |
|---|
| 150 | # PURPOSE: Create all widgets needed for the form. |
|---|
| 151 | # The widgets are created acording to the information given in blstfields: |
|---|
| 152 | # |
|---|
| 153 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 154 | set data(ftop) [frame $self.f] |
|---|
| 155 | set blstentry "" |
|---|
| 156 | #CODE |
|---|
| 157 | set lab $blabel |
|---|
| 158 | set auxObj [LabelEntry $self.f.eCode -editable false -label $lab \ |
|---|
| 159 | -foreground $bcolor -width 3 -helptext [lindex $blsthelptexts 0]] |
|---|
| 160 | |
|---|
| 161 | #Se podría hacer que cuando el arrowbutton esta activo, al pinchar |
|---|
| 162 | #sobre el entry del LabelEntry se muestre la lista también |
|---|
| 163 | #bind $auxObj <Button-1> [list $self ShowList] |
|---|
| 164 | |
|---|
| 165 | lappend blstentry $auxObj |
|---|
| 166 | grid $auxObj -sticky nwe -row 0 -column 0 |
|---|
| 167 | |
|---|
| 168 | # ArrowButton |
|---|
| 169 | set auxObj [ArrowButton $self.f.abCode -dir bottom \ |
|---|
| 170 | -helptext [mc "List of values"] -command [list $self ShowList]] |
|---|
| 171 | grid $auxObj -sticky nws -row 0 -column 1 |
|---|
| 172 | |
|---|
| 173 | # Descriptions |
|---|
| 174 | for {set x 1} {$x<[llength $blstfields]} {incr x} { |
|---|
| 175 | if {$blabdesc} { |
|---|
| 176 | set lab [mc [lindex $blstfields $x]] |
|---|
| 177 | } else { |
|---|
| 178 | set lab "" |
|---|
| 179 | } |
|---|
| 180 | set auxObj [LabelEntry $self.f.eField$x -editable false \ |
|---|
| 181 | -label $lab -width 9 -helptext [lindex $blsthelptexts $x]] |
|---|
| 182 | lappend blstentry $auxObj |
|---|
| 183 | grid $auxObj -sticky new -row 0 -column [expr $x + 1] |
|---|
| 184 | } |
|---|
| 185 | |
|---|
| 186 | grid $self.f -sticky news |
|---|
| 187 | |
|---|
| 188 | grid columnconfigure $self.f 0 -weight 1 |
|---|
| 189 | grid rowconfigure $self.f 0 -weight 1 |
|---|
| 190 | |
|---|
| 191 | for {set i 1} {$i<[llength $blstentry]} {incr i} { |
|---|
| 192 | grid columnconfigure $self.f [expr $i + 1] -weight 3 |
|---|
| 193 | } |
|---|
| 194 | |
|---|
| 195 | # Toplevel desplegable |
|---|
| 196 | set data(fbottom) [set f [toplevel $self.t -bg white -borderwidth 0\ |
|---|
| 197 | -relief solid]] |
|---|
| 198 | #wm deiconify $f |
|---|
| 199 | wm resizable $f 0 0 |
|---|
| 200 | wm overrideredirect $f 1 |
|---|
| 201 | wm withdraw $f |
|---|
| 202 | |
|---|
| 203 | ScrolledWindow $f.sw |
|---|
| 204 | set data(lb) [::mclistbox::mclistbox $f.sw.lb \ |
|---|
| 205 | -background white -columnborderwidth 0\ |
|---|
| 206 | -font {Arial 8} -labelfont {Arial 8}] |
|---|
| 207 | $f.sw setwidget $f.sw.lb |
|---|
| 208 | set lv $data(lb) |
|---|
| 209 | #bind $lv <Button-1> +[list focus -force %W] |
|---|
| 210 | bind $lv <KeyPress-Escape> +[list $self CloseList -1 -1] |
|---|
| 211 | bind $lv <KeyPress-Return> +[list $self ListViewOnClick] |
|---|
| 212 | # cabeceras de las columnas |
|---|
| 213 | if {[llength $blsttitlecol]} { |
|---|
| 214 | set lst $blsttitlecol |
|---|
| 215 | } else { |
|---|
| 216 | set lst $blstfields |
|---|
| 217 | } |
|---|
| 218 | set blstcolumns "" |
|---|
| 219 | foreach nc $lst { |
|---|
| 220 | # Ajustamos el mínimo ancho de cada columna: |
|---|
| 221 | set len [string length $nc] |
|---|
| 222 | $lv column add $nc -label $nc -width $len |
|---|
| 223 | lappend blstcolumns $lv.frame$nc.listbox |
|---|
| 224 | } |
|---|
| 225 | # La ultima columna es la que se expande |
|---|
| 226 | if [info exist nc] { |
|---|
| 227 | $data(lb) configure -fillcolumn $nc |
|---|
| 228 | } |
|---|
| 229 | |
|---|
| 230 | #Bind command to aply when double-clicking: |
|---|
| 231 | bind $f <ButtonPress> [list $self CloseList %X %Y] |
|---|
| 232 | |
|---|
| 233 | bind $lv <Double-Button-1> +[list $self ListViewOnClick] |
|---|
| 234 | |
|---|
| 235 | grid $f.sw -sticky news |
|---|
| 236 | grid columnconfigure $f 0 -weight 1 |
|---|
| 237 | grid rowconfigure $f 0 -weight 1 |
|---|
| 238 | |
|---|
| 239 | #Configuramos el bselectfields |
|---|
| 240 | grid columnconfigure $self 0 -weight 1 |
|---|
| 241 | grid rowconfigure $self 0 -weight 1 |
|---|
| 242 | } |
|---|
| 243 | |
|---|
| 244 | |
|---|
| 245 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 246 | method ShowList {args} { |
|---|
| 247 | # |
|---|
| 248 | # PURPOSE: Show the selection list in a new window. |
|---|
| 249 | # |
|---|
| 250 | # TODO: Leave creation of the widget to the Create method. This shoul only show it! |
|---|
| 251 | # |
|---|
| 252 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 253 | # ejecutamos comando previo a la visulizacion |
|---|
| 254 | if {[string length $bpostcommand ]} { |
|---|
| 255 | eval $bpostcommand |
|---|
| 256 | } |
|---|
| 257 | set lv $data(lb) |
|---|
| 258 | focus $lv |
|---|
| 259 | # cabeceras de las columnas |
|---|
| 260 | if {[llength $blsttitlecol]} { |
|---|
| 261 | set lst $blsttitlecol |
|---|
| 262 | } else { |
|---|
| 263 | set lst $blstfields |
|---|
| 264 | } |
|---|
| 265 | if {[winfo viewable $data(fbottom)] == 1} { |
|---|
| 266 | wm withdraw $data(fbottom) |
|---|
| 267 | grab release $data(fbottom) |
|---|
| 268 | } else { |
|---|
| 269 | set vwidth [winfo reqwidth $data(fbottom)] |
|---|
| 270 | set vheight [winfo reqheight $data(fbottom)] |
|---|
| 271 | wm deiconify $data(fbottom) |
|---|
| 272 | wm geometry $data(fbottom) \ |
|---|
| 273 | "${vwidth}x${vheight}+[winfo rootx $data(ftop)]+[expr \ |
|---|
| 274 | [winfo rooty $data(ftop)]+[winfo height $data(ftop)]]" |
|---|
| 275 | focus -force $data(fbottom) |
|---|
| 276 | grab -global $data(fbottom) |
|---|
| 277 | bind $data(fbottom) <ButtonPress> [list $self CloseList %X %Y] |
|---|
| 278 | } |
|---|
| 279 | |
|---|
| 280 | |
|---|
| 281 | #Limpiamos el listbox: |
|---|
| 282 | $lv delete 0 end |
|---|
| 283 | #Cargamos los valores del listbox: |
|---|
| 284 | foreach val $blstvalues { |
|---|
| 285 | $lv insert end $val |
|---|
| 286 | #Ajustamos el ancho de cada columna, si es necesario: |
|---|
| 287 | set i 0 |
|---|
| 288 | foreach col $val { |
|---|
| 289 | # Leemos el ancho del dato: |
|---|
| 290 | set datalen [string length $col] |
|---|
| 291 | #Leemos el ancho de la actual columna del listbox: |
|---|
| 292 | set name [lindex $lst $i] |
|---|
| 293 | set length [$lv.frame$name cget -width] |
|---|
| 294 | #Comparamos el ancho del dato con el del listbox: |
|---|
| 295 | set datalen [expr $datalen * 8] |
|---|
| 296 | if {$datalen > $length} { |
|---|
| 297 | #Adjust column width: |
|---|
| 298 | $lv.frame$name configure -width $datalen |
|---|
| 299 | } |
|---|
| 300 | incr i |
|---|
| 301 | } |
|---|
| 302 | } |
|---|
| 303 | # Marcamos la línea seleccionada, de existir |
|---|
| 304 | set txt [$self.f.eCode cget -text] |
|---|
| 305 | if {[string length $txt]} { |
|---|
| 306 | set l [[lindex $blstcolumns 0] get 0 end] |
|---|
| 307 | set pos [lsearch $l $txt] |
|---|
| 308 | if {$pos != -1} { |
|---|
| 309 | foreach obj $blstcolumns { |
|---|
| 310 | $obj selection set $pos |
|---|
| 311 | } |
|---|
| 312 | } |
|---|
| 313 | } |
|---|
| 314 | |
|---|
| 315 | |
|---|
| 316 | ################################################################################ |
|---|
| 317 | |
|---|
| 318 | # Posicionamos el dialogo: |
|---|
| 319 | set tp [expr [winfo pointery $self.f.eCode] + ([winfo height $self.f.eCode] / 2)] |
|---|
| 320 | set lft [expr [winfo pointerx $self.f.eCode] - [winfo width $self.f.eCode]] |
|---|
| 321 | |
|---|
| 322 | set width 0 |
|---|
| 323 | foreach name $lst { |
|---|
| 324 | # Ancho del texto. |
|---|
| 325 | # + 2 * Ancho del borde. |
|---|
| 326 | # + Ancho de la barra de scroll. |
|---|
| 327 | # + Ancho de separador. |
|---|
| 328 | set width [expr $width + [$lv.frame$name cget -width] \ |
|---|
| 329 | + ( 2 * [$lv.frame$name cget -border] ) + 2 ] |
|---|
| 330 | } |
|---|
| 331 | #Si el ancho de la ventana no es suficiente para los botones: |
|---|
| 332 | if {$width < 250} { |
|---|
| 333 | #Añadimos el ancho extra repartido entre todas las columnas: |
|---|
| 334 | set plus [expr (250 - $width) / [llength $lst]] |
|---|
| 335 | foreach name $lst { |
|---|
| 336 | set w [$lv.frame$name cget -width] |
|---|
| 337 | $lv.frame$name configure -width [expr $w + $plus] |
|---|
| 338 | } |
|---|
| 339 | set width 250 |
|---|
| 340 | } elseif {$width > 800} { |
|---|
| 341 | #If the window width is too much just cut out the wider column: |
|---|
| 342 | set maxw 0 |
|---|
| 343 | foreach name $lst { |
|---|
| 344 | set w [$lv.frame$name cget -width] |
|---|
| 345 | if {$w > $maxw} { |
|---|
| 346 | set maxw $w |
|---|
| 347 | set wn $name |
|---|
| 348 | } |
|---|
| 349 | } |
|---|
| 350 | $lv.frame$wn configure -width [expr $maxw - ($width - 800) ] |
|---|
| 351 | set width 800 |
|---|
| 352 | } |
|---|
| 353 | #20 * numero de datos + 100 (Botones y separador) |
|---|
| 354 | set height [expr ([llength $blstvalues] * 20) + 100] |
|---|
| 355 | if { $height > 300} { |
|---|
| 356 | set height 300 |
|---|
| 357 | } |
|---|
| 358 | |
|---|
| 359 | # #wm geometry $dialog ${wd}x250+$lft+$tp |
|---|
| 360 | wm geometry $data(fbottom) ${width}x$height+$lft+$tp |
|---|
| 361 | } |
|---|
| 362 | |
|---|
| 363 | method CloseList {x y} { |
|---|
| 364 | if {[expr $x==-1 && $y==-1]} { |
|---|
| 365 | wm withdraw $data(fbottom) |
|---|
| 366 | grab release $data(fbottom) |
|---|
| 367 | } else { |
|---|
| 368 | # Puede dar un error si la ventana no es de la aplicacion actual |
|---|
| 369 | set nw [winfo containing $x $y] |
|---|
| 370 | if {[winfo toplevel $nw] != $data(fbottom)} { |
|---|
| 371 | wm withdraw $data(fbottom) |
|---|
| 372 | grab release $data(fbottom) |
|---|
| 373 | } |
|---|
| 374 | } |
|---|
| 375 | } |
|---|
| 376 | |
|---|
| 377 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 378 | method ListViewOnClick {args} { |
|---|
| 379 | # |
|---|
| 380 | # PURPOSE: Captura la fila seleccionada, captura cada elemento e introduce |
|---|
| 381 | # sus valores en los entrys |
|---|
| 382 | # |
|---|
| 383 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 384 | # capturamos los valores seleccionados |
|---|
| 385 | set i 0 |
|---|
| 386 | foreach obj $blstentry { |
|---|
| 387 | set lb [lindex $blstcolumns $i] |
|---|
| 388 | set lst [$lb curselection] |
|---|
| 389 | if {[llength $lst]} { |
|---|
| 390 | set pos [$lb index active] |
|---|
| 391 | $obj configure -text [$lb get $pos] |
|---|
| 392 | } |
|---|
| 393 | incr i |
|---|
| 394 | } |
|---|
| 395 | # ocultamos el dialogo |
|---|
| 396 | #$self CloseList 0 0 |
|---|
| 397 | $self CloseList [winfo rootx $data(ftop)] [winfo rooty $data(ftop)] |
|---|
| 398 | if {[string length $bmodifycmd]} { |
|---|
| 399 | eval $bmodifycmd |
|---|
| 400 | } |
|---|
| 401 | } |
|---|
| 402 | |
|---|
| 403 | |
|---|
| 404 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 405 | method SetLstValues {lst args} { |
|---|
| 406 | # |
|---|
| 407 | # PURPOSE: Especificamos los valores a mostrar en la lista de seleccion |
|---|
| 408 | # DEPRECATED. Se debe llamar a '$widget configure -bvalues $lst' |
|---|
| 409 | # |
|---|
| 410 | # PARAMETERS: |
|---|
| 411 | # lst -> lista de listas con los valores a mostrar |
|---|
| 412 | # |
|---|
| 413 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 414 | set blstvalues $lst |
|---|
| 415 | } |
|---|
| 416 | |
|---|
| 417 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 418 | method GetValueList {args} { |
|---|
| 419 | # |
|---|
| 420 | # PURPOSE: |
|---|
| 421 | # |
|---|
| 422 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 423 | return $blstvalues |
|---|
| 424 | } |
|---|
| 425 | |
|---|
| 426 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 427 | method GetValue {args} { |
|---|
| 428 | # |
|---|
| 429 | # PURPOSE: Obtenemos los valores seleccionados |
|---|
| 430 | # |
|---|
| 431 | # RETRUN: Una lista con los valores seleccionados |
|---|
| 432 | # |
|---|
| 433 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 434 | set lst "" |
|---|
| 435 | foreach obj $blstentry { |
|---|
| 436 | lappend lst [$obj cget -text] |
|---|
| 437 | } |
|---|
| 438 | return $lst |
|---|
| 439 | } |
|---|
| 440 | |
|---|
| 441 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 442 | method SetValue {lst args} { |
|---|
| 443 | # |
|---|
| 444 | # PURPOSE: Insertamos los valores en los entrys |
|---|
| 445 | # |
|---|
| 446 | # PARAMETERS: lst -> lista con los valores a incluir |
|---|
| 447 | # |
|---|
| 448 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 449 | # limpiamos valores visualizados |
|---|
| 450 | $self Clean |
|---|
| 451 | # introducuimos valores |
|---|
| 452 | set i 0 |
|---|
| 453 | foreach obj $blstentry { |
|---|
| 454 | $obj configure -text [lindex $lst $i] |
|---|
| 455 | incr i |
|---|
| 456 | } |
|---|
| 457 | } |
|---|
| 458 | |
|---|
| 459 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 460 | method Clean {args} { |
|---|
| 461 | # |
|---|
| 462 | # PURPOSE: Vaciamos el valor de todos los entrys |
|---|
| 463 | # |
|---|
| 464 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 465 | # introducuimos valores |
|---|
| 466 | foreach obj $blstentry { |
|---|
| 467 | $obj configure -text "" |
|---|
| 468 | } |
|---|
| 469 | } |
|---|
| 470 | |
|---|
| 471 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 472 | method Configure {opc val args} { |
|---|
| 473 | # |
|---|
| 474 | # PURPOSE: Aplicamos una opcion a todos los entry |
|---|
| 475 | # |
|---|
| 476 | # PARAMETERS: |
|---|
| 477 | # opc: opcion a aplicar |
|---|
| 478 | # val: valor asociado a la opcion |
|---|
| 479 | # |
|---|
| 480 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 481 | # introducuimos valores |
|---|
| 482 | foreach obj $blstentry { |
|---|
| 483 | $obj configure -$opc $val |
|---|
| 484 | } |
|---|
| 485 | } |
|---|
| 486 | |
|---|
| 487 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 488 | method ConfigureDesc {opc val args} { |
|---|
| 489 | # |
|---|
| 490 | # PURPOSE: Aplicamos una opcion a todos los entry, menos al codigo (primero) |
|---|
| 491 | # |
|---|
| 492 | # PARAMETERS: |
|---|
| 493 | # opc: opcion a aplicar |
|---|
| 494 | # val: valor asociado a la opcion |
|---|
| 495 | # |
|---|
| 496 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 497 | # introducuimos valores |
|---|
| 498 | set lst [lrange $blstentry 1 end] |
|---|
| 499 | foreach obj $lst { |
|---|
| 500 | $obj configure $opc $val |
|---|
| 501 | } |
|---|
| 502 | } |
|---|
| 503 | |
|---|
| 504 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 505 | method Activate {stt args} { |
|---|
| 506 | # |
|---|
| 507 | # PURPOSE: Aplicamos una opción a los elemetos del componente. Por un lado |
|---|
| 508 | # al entry del código, al botón y al resto de campos entry. |
|---|
| 509 | # |
|---|
| 510 | # PARAMETERS: |
|---|
| 511 | # stt: opción a aplicar |
|---|
| 512 | # normal -> Code (yes) Button (no) Desc (no) |
|---|
| 513 | # active -> Code (yes) Button (no) Desc (yes) |
|---|
| 514 | # select -> Code (no) Button (yes) Desc (no) |
|---|
| 515 | # disabled -> Code (no) Button (no) Desc (yes) |
|---|
| 516 | # notactive -> Code (no) Button (no) Desc (no) |
|---|
| 517 | # |
|---|
| 518 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 519 | # introducimos valores |
|---|
| 520 | switch $stt { |
|---|
| 521 | "normal" { |
|---|
| 522 | BfoActivateWidget $self.f.eCode $stt |
|---|
| 523 | $self.f.eCode configure -editable true |
|---|
| 524 | BfoActivateWidget $self.f.abCode "disabled" |
|---|
| 525 | $self ConfigureDesc -state disabled |
|---|
| 526 | $self ConfigureDesc -editable false |
|---|
| 527 | } |
|---|
| 528 | "active" { |
|---|
| 529 | BfoActivateWidget $self.f.eCode "normal" |
|---|
| 530 | $self.f.eCode configure -editable true |
|---|
| 531 | BfoActivateWidget $self.f.abCode "disabled" |
|---|
| 532 | $self ConfigureDesc -state normal |
|---|
| 533 | $self ConfigureDesc -editable true |
|---|
| 534 | } |
|---|
| 535 | "select" { |
|---|
| 536 | BfoActivateWidget $self.f.eCode "disabled" |
|---|
| 537 | $self.f.eCode configure -editable false |
|---|
| 538 | BfoActivateWidget $self.f.abCode "active" |
|---|
| 539 | $self ConfigureDesc -state normal |
|---|
| 540 | $self ConfigureDesc -editable false |
|---|
| 541 | } |
|---|
| 542 | "disabled" { |
|---|
| 543 | BfoActivateWidget $self.f.eCode "disabled" |
|---|
| 544 | $self.f.eCode configure -editable false |
|---|
| 545 | BfoActivateWidget $self.f.abCode "disabled" |
|---|
| 546 | $self ConfigureDesc -state normal |
|---|
| 547 | $self ConfigureDesc -editable true |
|---|
| 548 | } |
|---|
| 549 | "notactive" { |
|---|
| 550 | BfoActivateWidget $self.f.eCode "disabled" |
|---|
| 551 | $self.f.eCode configure -editable false |
|---|
| 552 | BfoActivateWidget $self.f.abCode "disabled" |
|---|
| 553 | $self ConfigureDesc -state normal |
|---|
| 554 | $self ConfigureDesc -editable false |
|---|
| 555 | } |
|---|
| 556 | default { |
|---|
| 557 | puts "BSelectFields Activate ERROR: invalid state: $stt" |
|---|
| 558 | } |
|---|
| 559 | } |
|---|
| 560 | } |
|---|
| 561 | |
|---|
| 562 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 563 | method SetModifyCmd {modCmd args} { |
|---|
| 564 | # |
|---|
| 565 | # PURPOSE: Especifica un comando a aplicar al presionar el boton aceptar |
|---|
| 566 | # de la lista de seleccion |
|---|
| 567 | # |
|---|
| 568 | # PARAMETERS: modCmd -> sentencia a ejecutar |
|---|
| 569 | # |
|---|
| 570 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 571 | set bmodifycmd $modCmd |
|---|
| 572 | } |
|---|
| 573 | |
|---|
| 574 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 575 | method GetCode {args} { |
|---|
| 576 | # |
|---|
| 577 | # PURPOSE: Devuelve el primer elemento de los seleccionados. Corresponde al |
|---|
| 578 | # codigo |
|---|
| 579 | # |
|---|
| 580 | # RETURN: Valor del codigo |
|---|
| 581 | # |
|---|
| 582 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 583 | return [lindex [$self GetValue] 0] |
|---|
| 584 | } |
|---|
| 585 | |
|---|
| 586 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 587 | method SelCode {code} { |
|---|
| 588 | # |
|---|
| 589 | # PURPOSE: Insertamos los valores en los entrys |
|---|
| 590 | # |
|---|
| 591 | # PARAMETERS: lst -> lista con los valores a incluir |
|---|
| 592 | # |
|---|
| 593 | # Corrected (Bugs: Si no encuentra el code debe devolver un error (-1)) |
|---|
| 594 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 595 | #Recorremos la lista para encontrar el indice del code: |
|---|
| 596 | set i 0 |
|---|
| 597 | set index -9999 |
|---|
| 598 | foreach {row} $blstvalues { |
|---|
| 599 | if { [lindex $row 0] == $code } { |
|---|
| 600 | set index $i |
|---|
| 601 | } |
|---|
| 602 | incr i |
|---|
| 603 | } |
|---|
| 604 | if {$index eq -9999} { |
|---|
| 605 | return -1 |
|---|
| 606 | } |
|---|
| 607 | #set index [lsearch -exact $blstvalues $code] |
|---|
| 608 | # limpiamos valores visualizados |
|---|
| 609 | $self Clean |
|---|
| 610 | # introducimos valores |
|---|
| 611 | set i 0 |
|---|
| 612 | foreach obj $blstentry { |
|---|
| 613 | $obj configure -text [lindex [lindex $blstvalues $index] $i] |
|---|
| 614 | incr i |
|---|
| 615 | } |
|---|
| 616 | } |
|---|
| 617 | |
|---|
| 618 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 619 | method SetValueView {lst args} { |
|---|
| 620 | # |
|---|
| 621 | # PURPOSE: Insertamos los valores en los entrys |
|---|
| 622 | # |
|---|
| 623 | # PARAMETERS: args -> lista con los valores a incluir, el primero es el del |
|---|
| 624 | # codigo |
|---|
| 625 | # |
|---|
| 626 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 627 | # limpiamos valores visualizados |
|---|
| 628 | $self Clean |
|---|
| 629 | # introducuimos valores |
|---|
| 630 | set i 0 |
|---|
| 631 | foreach obj $blstentry { |
|---|
| 632 | set current [$obj cget -state] |
|---|
| 633 | $obj configure -state normal |
|---|
| 634 | $obj configure -text [lindex $lst $i] |
|---|
| 635 | $obj configure -state $current |
|---|
| 636 | incr i |
|---|
| 637 | } |
|---|
| 638 | } |
|---|
| 639 | |
|---|
| 640 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 641 | method getwidget {} { |
|---|
| 642 | # |
|---|
| 643 | # PURPOSE: Obtenemos el nombre de todos los objetos creados |
|---|
| 644 | # |
|---|
| 645 | # PARAMETERS: lista con el path de los entrys creados |
|---|
| 646 | # |
|---|
| 647 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 648 | return $blstentry |
|---|
| 649 | } |
|---|
| 650 | |
|---|
| 651 | } |
|---|
| 652 | |
|---|
| 653 | package provide bselectfields 1.0 |
|---|
