#------------------------------------------------------------------------ # Compagny : 4Js # Developper : PM # Program : $PROJET/objects/button.obj # Date : 05.10.1995 # Last. modif. : 26.10.1995 # Title : Description des classes de base #------------------------------------------------------------------------ # Explication : # Displaying is assumed by the methode Display_..., called by # the display event of the object. Define_Button creates the graphical # object, with root window and so on. But only the Pack_... (and # eventually the Place_...- ) -methodes can display it on screen. # So Display_... is tk-independant. # The display event is called with optionnaly root parameter (in this case, # the actually object root is lost and replaced with the new), but the # define, pack_it, place_it are without root parameter, because it is # assumed that the root is already known. # ====================================================================== Class Button { inherit TextWidget global Default #vars : public int_command "" public int_command_bef "" ;# Internal command befor. public int_command_aft "" ;# Internal command after. public geo_bitmap "" public geo_active_bg $Default(Widget,ActiveBg) public geo_active_fg black public geo_x 100 public geo_y 100 # public geo_width $Default(Button,TWidth) # public geo_height $Default(Button,THeight) public geo_relief $Default(Button,Relief) public geo_bg $Default(Widget,Bg) public geo_attach "top" constructor { config } { # set geo_text $this } method config {config} {} #----------------------------------------------------------------------- # Refresh_Button : # 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 !!! 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 -activebackground $geo_active_bg lappend cmd -activeforeground $geo_active_fg lappend cmd -borderwidth $geo_borderwidth lappend cmd -relief $geo_relief lappend cmd -bitmap $geo_bitmap if { $geo_width != 0} { lappend cmd -width $geo_width } if { $geo_height != 0} { lappend cmd -height $geo_height } lappend cmd -text $geo_text # puts "Refresh_Button: Voici le nouvel object avec cmd >$cmd<" eval $cmd #lappend cmd -padx $geo_padx #lappend cmd -pady $geo_pady } #----------------------------------------------------------------------- # Define_Button : # 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 button ${geo_root}w$int_name lappend cmd -bg $geo_bg lappend cmd -fg $geo_fg lappend cmd -borderwidth $geo_borderwidth lappend cmd -activebackground $geo_active_bg lappend cmd -activeforeground $geo_active_fg lappend cmd -command "$int_command_bef;$int_command;$int_command_aft" lappend cmd -relief $geo_relief lappend cmd -bitmap $geo_bitmap if {$geo_width != 0} { lappend cmd -width $geo_width } if {$geo_height != 0} { lappend cmd -height $geo_height } lappend cmd -text $geo_text lappend cmd -anchor $geo_anchor # puts "Define_Button: Voici le nouvel object avec label >$geo_text<" set geo_widget [ eval $cmd ] #lappend cmd -padx $geo_padx #lappend cmd -pady $geo_pady } #----------------------------------------------------------------------- # Invoke Button : # This is just an overhead of the low level widget event. It's a button # specification. # Returns : nothing. #....................................................................... method invoke { } { if {$geo_widget != ""} { $geo_widget invoke } else { return -1 } } } ;# end of class # ======================================================================