BeveledBorder.st
author Claus Gittinger <cg@exept.de>
Thu, 29 Oct 2009 18:24:34 +0100
changeset 5438 102f9d8b7c0e
parent 5409 760947d044f1
child 5460 799eea292a22
permissions -rw-r--r--
*** empty log message ***

"{ Package: 'stx:libview' }"

AbstractBorder subclass:#BeveledBorder
	instanceVariableNames:'shadowColor lightColor level'
	classVariableNames:'RaisedBorder2 InsetBorder2 RaisedBorder1 InsetBorder1'
	poolDictionaries:''
	category:'Graphics-Support'
!

!BeveledBorder class methodsFor:'documentation'!

examples
"
     |v b|

     v := StandardSystemView extent:10@10.
     v openAndWait.

     b := BeveledBorder raised.
     b displayOn:v forDisplayBox:(0@0 corner:9@9).




     |v b|

     v := StandardSystemView extent:100@100.
     v openAndWait.

     b := BeveledBorder inset1.
     b displayOn:v forDisplayBox:(0@0 corner:99@99).

"
! !

!BeveledBorder class methodsFor:'instance creation'!

level:aNumber
    aNumber == 1 ifTrue:[^ self raised1].
    aNumber == -11 ifTrue:[^ self inset1].
    ^ self new level:aNumber
!

level:aNumber color:aColor
    aNumber == 1 ifTrue:[^ self raised1].
    aNumber == -11 ifTrue:[^ self inset1].
    ^ self new level:aNumber color:aColor
! !

!BeveledBorder class methodsFor:'constants'!

inset
    "Answer the default beveled border with inset edges."

    InsetBorder2 isNil ifTrue:[
        InsetBorder2 := self new level:-2
    ].
    ^ InsetBorder2

    "
     self inset
    "
!

inset1
    "Answer the default beveled border with inset edges of thickness 1."

    InsetBorder1 isNil ifTrue:[
        InsetBorder1 := self new level:-1
    ].
    ^ InsetBorder1
!

raised
    "Answer the default beveled border with raised edges."

    RaisedBorder2 isNil ifTrue:[
        "/ RaisedBorder := self new setBorderWidth: 2.
        RaisedBorder2 := self new level:2
    ].
    ^ RaisedBorder2
!

raised1
    "Answer the default beveled border with raised edges of thickness 1."

    RaisedBorder1 isNil ifTrue:[
        "/ RaisedBorder := self new setBorderWidth: 1.
        RaisedBorder1 := self new level:1
    ].
    ^ RaisedBorder1
! !

!BeveledBorder methodsFor:'accessing'!

color:aColor
    shadowColor := aColor slightlyDarkened.
    lightColor := aColor slightlyLightened.
!

level
    ^ level

    "Created: / 6.7.1998 / 17:36:59 / cg"
!

level:anInteger
    level := anInteger.
    width := level abs.

    "Created: / 6.7.1998 / 13:42:09 / cg"
    "Modified: / 6.7.1998 / 17:37:17 / cg"
!

level:aNumber color:aColor
    self level:aNumber.
    self color:aColor.
! !

!BeveledBorder methodsFor:'displaying'!

displayOn:aGC forDisplayBox:aRectangle
    |oldPaint boxLeft boxTop boxWidth boxHeight light shadow|

    oldPaint := aGC paint.

    boxLeft := aRectangle left.
    boxTop := aRectangle top.
    boxWidth := aRectangle width.
    boxHeight := aRectangle height.

    (lightColor notNil and:[shadowColor notNil]) ifTrue:[
        light := lightColor. 
        shadow := shadowColor.
    ] ifFalse:[
        light := aGC lightColor. 
        shadow := aGC shadowColor.
    ].

    aGC 
        drawEdgesForX:boxLeft y:boxTop width:boxWidth height:boxHeight level:(level ? width)
        shadow:shadow light:light
        halfShadow:nil halfLight:nil
        style:nil.

    aGC paint:oldPaint.

    "
     View new
        border:(BeveledBorder level:2 color:Color red);
        open.
    "
    "
     View new
        border:(BeveledBorder level:4 color:Color red);
        open.
    "

    "
     StandardSystemView new
        extent:200@200;
        add:(View new
                origin:(10@10) corner:0.9@0.9;
                border:(BeveledBorder width:4 color:Color red));
        open.
    "
! !

!BeveledBorder class methodsFor:'documentation'!

version_CVS
    ^ '$Header: /cvs/stx/stx/libview/BeveledBorder.st,v 1.3 2009-10-29 17:24:34 cg Exp $'
! !