#------------------------------------------------------------------------ # Compagny : 4Js # Developper : PM # Program : $PROJET/objects/listbox.obj # Date : 05.10.1995 # Last. modif. : 26.10.1995 # Title : Description des classes de base #....................................................................... # # Explication : # #======================================================================== Class Listbox { inherit Entry global Default #vars : public int_command "" public int_variable "" ;# public int_text "" ;# !! differs from geo_text !! public geo_x 10 public geo_y 10 public geo_bg $Default(Entry,Bg) # public geo_value "" public geo_height 1 public geo_width 2 public geo_rPad 2 protected int_oldidx -1 constructor { config } { } destructor { } #----------------------------------------------------------------------- # Refresh_Listbox : # Reconfiguration of the graphical object, ... # Entry : name : Entity name of object # Returns : nothing. #....................................................................... method refresh { } { set cmd "" ;# Creation de la commande adaptee a l'objet !!! set int_oldidx -1 lappend cmd $geo_widget configure # lappend cmd -command "$int_command_bef; $int_command; $int_command_aft " lappend cmd -bg $geo_bg lappend cmd -fg $geo_fg lappend cmd -selectbackground $geo_active_bg lappend cmd -selectforeground $geo_active_fg # lappend cmd -padx $geo_padx # lappend cmd -pady $geo_pady lappend cmd -borderwidth $geo_borderwidth lappend cmd -highlightbackground $geo_highlight_bg lappend cmd -relief $geo_relief # lappend cmd -anchor w if { $geo_width != 0} { # lappend cmd -width $geo_width } # lappend cmd -text $geo_text # lappend cmd -variable $int_variable # lappend cmd -value $geo_value # puts stderr "Refresh_Listbox: Voici le nouvel object avec cmd >$cmd<" eval $cmd $geo_widget delete 0 end foreach entity $int_text { $geo_widget insert end $entity } $geo_widget config -geometry ${geo_width}x${geo_height} # puts stderr "Listbox::refresh; geo_width is ${geo_width} and geo_height is ${geo_height}" } #----------------------------------------------------------------------- # Define_Listbox : # Creation of the graphical object, with full path... # Entry : name : Entity name of object # Returns : nothing. #....................................................................... method define { } { set cmd "" ;# Creation de la commande adaptee a l'objet !!! lappend cmd listbox $geo_root$int_name lappend cmd -bg $geo_bg # lappend cmd -selectbackground $geo_active_bg lappend cmd -selectforeground $geo_active_fg lappend cmd -highlightbackground $geo_highlight_bg lappend cmd -fg $geo_fg # lappend cmd -padx $geo_padx # lappend cmd -pady $geo_pady lappend cmd -borderwidth $geo_borderwidth # lappend cmd -command "$int_command_bef;$int_command;$int_command_aft" lappend cmd -relief $geo_relief # lappend cmd -anchor w if {$geo_width != 0} { # lappend cmd -width $geo_width } if {$geo_height != 0} { # lappend cmd -height $geo_height } # puts "Define_Listbox: Voici le nouvel object avec label >$geo_text<" set geo_widget [ eval $cmd ] foreach entity $int_text { $geo_widget insert end $entity } $geo_widget config -geometry ${geo_width}x${geo_height} bind $geo_widget " $this highlight \[\[$this getPub -geo_widget\] nearest %y\]" bind $geo_widget "$this execute " } #----------------------------------------------------------------------- # highlight : # Entry : Entity name of object, and row index (0, 1, 2...) # Returns : nothing. #....................................................................... method highlight { {idx ""} } { if {$geo_widget == ""} { return } if { $idx != "" } { $geo_widget highlight $idx } else { $geo_widget highlight } } #----------------------------------------------------------------------- # execute : # Entry : Entity name of object, and eventually arguments # Returns : nothing. #....................................................................... method execute { args } { if {$int_command != ""} { eval $int_command $args } } #----------------------------------------------------------------------- # push : # Entry : Entity name of object, and eventually arguments # Returns : nothing. #....................................................................... method push { args } { foreach word $args { $geo_widget insert 0 $word } } #----------------------------------------------------------------------- # append : # Entry : Entity name of object, and eventually arguments # Returns : nothing. #....................................................................... method append { args } { set lg 0 ;# lenght of words foreach word $args { # $geo_widget insert end $word lappend int_text $word set lg [string length $word] if {$geo_width < $lg} { set geo_width $lg } incr geo_height } } #----------------------------------------------------------------------- # insert : # Entry : Entity name of object, and eventually arguments # Returns : nothing. #....................................................................... method insert { idx args } { foreach word $args { $geo_widget insert $idx $word } } #----------------------------------------------------------------------- # del : # Entry : Entity name of object, and eventually arguments # Returns : nothing. #....................................................................... method del { idx } { $geo_widget delete $idx } #----------------------------------------------------------------------- # get : # Entry : Entity name of object, and eventually arguments # Returns : nothing. #....................................................................... method get { idx } { return [$geo_widget get $idx] } #----------------------------------------------------------------------- # value : # Entry : Entity name of object, and eventually arguments # Returns : nothing. #....................................................................... method value { } { return [$geo_widget get [$geo_widget highlight]] } #----------------------------------------------------------------------- # Entry : Entity name of object, and eventually arguments # Returns : nothing. #....................................................................... method curselection { } { return [$geo_widget curselection] } } ;# end of class # ======================================================================