| 1 | package require Metawidget |
|---|
| 2 | |
|---|
| 3 | # name: Ibutton |
|---|
| 4 | # args: args: option-value pairs |
|---|
| 5 | # outside is a frame, inside a label and a button. The button is used so that |
|---|
| 6 | # this metawidget can take the focus. the bindings simply redirect clicks |
|---|
| 7 | # on the frame or the image to the inner button. all following methods |
|---|
| 8 | # just redirect a particular option to the appropriate widget(s). |
|---|
| 9 | metawidget create Ibutton { |
|---|
| 10 | pack [frame $this.ibut -border 2 -relief raised] -fill both -expand 1 |
|---|
| 11 | grid [label $this.ibut.icon -padx 0 -pady 0] -column 0 -row 0 |
|---|
| 12 | grid [button $this.ibut.text -padx 0 -pady 0 -border 0] -column 1 -row 0 |
|---|
| 13 | |
|---|
| 14 | bind $this.ibut <Button-1> "$this config -relief sunken" |
|---|
| 15 | bind $this.ibut <ButtonRelease-1> "$this config -relief raised; $this.ibut.text invoke" |
|---|
| 16 | bind $this.ibut.icon <Button-1> "$this config -relief sunken" |
|---|
| 17 | bind $this.ibut.icon <ButtonRelease-1> "$this config -relief raised; $this.ibut.text invoke" |
|---|
| 18 | bind $this.ibut.text <Button-1> "$this config -relief sunken" |
|---|
| 19 | bind $this.ibut.text <ButtonRelease-1> "$this config -relief raised" |
|---|
| 20 | |
|---|
| 21 | my -text {} |
|---|
| 22 | my -image {} |
|---|
| 23 | } {} -default ibut.text |
|---|
| 24 | |
|---|
| 25 | metawidget proc Ibutton _opt { sOpt sVal } { |
|---|
| 26 | switch -- $sOpt { |
|---|
| 27 | -image { $this.ibut.icon configure -image $sVal } |
|---|
| 28 | -relief { $this.ibut configure -relief $sVal } |
|---|
| 29 | -bd { $this.ibut configure -bd $sVal } |
|---|
| 30 | -bg { |
|---|
| 31 | $this.ibut config -bg $sVal |
|---|
| 32 | $this.ibut.icon config -bg $sVal |
|---|
| 33 | $this.ibut.text config -bg $sVal -activeback $sVal |
|---|
| 34 | } |
|---|
| 35 | } |
|---|
| 36 | } |
|---|
| 37 | |
|---|
| 38 | metawidget option Ibutton -image {_opt -image} |
|---|
| 39 | metawidget option Ibutton -bd {_opt -bd} |
|---|
| 40 | metawidget option Ibutton -borderwidth {_opt -bd} |
|---|
| 41 | metawidget option Ibutton -relief {_opt -relief} |
|---|
| 42 | metawidget option Ibutton -bg {_opt -bg} |
|---|
| 43 | metawidget option Ibutton -background {_opt -bg} |
|---|
| 44 | |
|---|
| 45 | proc test {} { |
|---|
| 46 | image create photo p1 -file ./demos/images/Compass.gif |
|---|
| 47 | image create photo p2 -file ./demos/images/Notebook.gif |
|---|
| 48 | |
|---|
| 49 | pack [button .but0 -text Regular] -fill x |
|---|
| 50 | pack [ibutton .ibt1 -border 5 -image p1 -text Compass] -fill x |
|---|
| 51 | pack [ibutton .ibt2 -image p2 -text Notebook -command {after 1000}] -fill x |
|---|
| 52 | } |
|---|
| 53 | |
|---|
| 54 | #test |
|---|
| 55 | |
|---|
