BeveledBorder.st
author Claus Gittinger <cg@exept.de>
Wed, 22 Aug 2018 12:58:11 +0200
changeset 8451 6eafe0433763
parent 7948 f4baf2f53ef0
permissions -rw-r--r--
#QUALITY by cg class: WindowSensor comment/format in: #basicAddDamage:view:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5460
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
     1
"
7948
f4baf2f53ef0 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 7382
diff changeset
     2
 COPYRIGHT (c) 2009 by Claus Gittinger / eXept Software AG
5460
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
     3
              All Rights Reserved
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
     4
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
     5
 This software is furnished under a license and may be used
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
     6
 only in accordance with the terms of that license and with the
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
     8
 be provided or otherwise made available to, or used by, any
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
     9
 other person.  No title to or ownership of the software is
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    10
 hereby transferred.
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    11
"
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
"{ Package: 'stx:libview' }"
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
6718
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    14
"{ NameSpace: Smalltalk }"
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    15
5438
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
    16
AbstractBorder subclass:#BeveledBorder
7382
7f4cfe947539 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
    17
	instanceVariableNames:'color shadowColor lightColor level'
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	classVariableNames:'RaisedBorder2 InsetBorder2 RaisedBorder1 InsetBorder1'
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	poolDictionaries:''
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	category:'Graphics-Support'
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!BeveledBorder class methodsFor:'documentation'!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
5460
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    25
copyright
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    26
"
7948
f4baf2f53ef0 #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 7382
diff changeset
    27
 COPYRIGHT (c) 2009 by Claus Gittinger / eXept Software AG
5460
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    28
              All Rights Reserved
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    29
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    30
 This software is furnished under a license and may be used
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    31
 only in accordance with the terms of that license and with the
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    33
 be provided or otherwise made available to, or used by, any
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    34
 other person.  No title to or ownership of the software is
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    35
 hereby transferred.
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    36
"
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    37
!
799eea292a22 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 5438
diff changeset
    38
6829
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    39
documentation
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    40
"
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    41
    This will replace the mixture of window-system supported borders and manually
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    42
    drawn 3D levels (which is ugly, but served me well for almost 20years now).
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    43
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    44
    [author:]
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    45
        Claus Gittinger
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    46
"
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    47
!
2a2eb369fa0d class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
    48
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
examples
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
"
6718
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    51
                                                [exBegin]
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    52
     |top v b|
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
6718
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    54
    
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    55
     top := StandardSystemView extent:100@100.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    56
     v := View origin:10@10 corner:90@30 in:top.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    57
     top openAndWait.
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
6718
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    59
     b := BeveledBorder raised1.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    60
     v border:b.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    61
     Delay waitForSeconds:1.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    62
     v border:(BeveledBorder level:2).
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    63
     Delay waitForSeconds:1.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    64
     v border:(BeveledBorder level:3).
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    65
     Delay waitForSeconds:1.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    66
     v border:(BeveledBorder level:-3).
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    67
     Delay waitForSeconds:1.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    68
     v border:(BeveledBorder level:-2).
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    69
     Delay waitForSeconds:1.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    70
     v border:(BeveledBorder level:-1).
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    71
     Delay waitForSeconds:1.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    72
     v border:(BeveledBorder level:0).
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    73
                                                [exEnd]
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
6718
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    75
                                                [exBegin]
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    76
     |top v b|
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
6718
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    78
     top := StandardSystemView extent:100@100.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    79
     v := View origin:10@10 corner:90@30 in:top.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    80
     top openAndWait.
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
     b := BeveledBorder inset1.
6718
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    83
     v border:b.
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
    84
                                                [exEnd]
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
"
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
! !
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
5409
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
    88
!BeveledBorder class methodsFor:'instance creation'!
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
    89
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
    90
level:aNumber
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
    91
    aNumber == 1 ifTrue:[^ self raised1].
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
    92
    aNumber == -11 ifTrue:[^ self inset1].
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
    93
    ^ self new level:aNumber
5438
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
    94
!
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
    95
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
    96
level:aNumber color:aColor
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
    97
    aNumber == 1 ifTrue:[^ self raised1].
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
    98
    aNumber == -11 ifTrue:[^ self inset1].
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
    99
    ^ self new level:aNumber color:aColor
5409
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
   100
! !
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
   101
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
!BeveledBorder class methodsFor:'constants'!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
inset
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
    "Answer the default beveled border with inset edges."
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    InsetBorder2 isNil ifTrue:[
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
        InsetBorder2 := self new level:-2
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
    ].
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
    ^ InsetBorder2
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
    "
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
     self inset
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
    "
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
inset1
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
    "Answer the default beveled border with inset edges of thickness 1."
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
    InsetBorder1 isNil ifTrue:[
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
        InsetBorder1 := self new level:-1
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
    ].
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
    ^ InsetBorder1
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
raised
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
    "Answer the default beveled border with raised edges."
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
    RaisedBorder2 isNil ifTrue:[
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
        "/ RaisedBorder := self new setBorderWidth: 2.
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
        RaisedBorder2 := self new level:2
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
    ].
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
    ^ RaisedBorder2
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
raised1
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
    "Answer the default beveled border with raised edges of thickness 1."
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
    RaisedBorder1 isNil ifTrue:[
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
        "/ RaisedBorder := self new setBorderWidth: 1.
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
        RaisedBorder1 := self new level:1
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
    ].
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
    ^ RaisedBorder1
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
! !
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
!BeveledBorder methodsFor:'accessing'!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
7382
7f4cfe947539 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
   148
color
7f4cfe947539 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
   149
    ^ color.
7f4cfe947539 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
   150
!
7f4cfe947539 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
   151
5438
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   152
color:aColor
7382
7f4cfe947539 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
   153
    color := aColor.
5438
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   154
    shadowColor := aColor slightlyDarkened.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   155
    lightColor := aColor slightlyLightened.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   156
!
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   157
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
level
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
    ^ level
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
    "Created: / 6.7.1998 / 17:36:59 / cg"
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
level:anInteger
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
    level := anInteger.
5409
760947d044f1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5394
diff changeset
   166
    width := level abs.
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
    "Created: / 6.7.1998 / 13:42:09 / cg"
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
    "Modified: / 6.7.1998 / 17:37:17 / cg"
5438
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   170
!
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   171
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   172
level:aNumber color:aColor
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   173
    self level:aNumber.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   174
    self color:aColor.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   175
! !
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   176
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   177
!BeveledBorder methodsFor:'displaying'!
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   178
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   179
displayOn:aGC forDisplayBox:aRectangle
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   180
    |oldPaint boxLeft boxTop boxWidth boxHeight light shadow|
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   181
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   182
    oldPaint := aGC paint.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   183
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   184
    boxLeft := aRectangle left.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   185
    boxTop := aRectangle top.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   186
    boxWidth := aRectangle width.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   187
    boxHeight := aRectangle height.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   188
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   189
    (lightColor notNil and:[shadowColor notNil]) ifTrue:[
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   190
        light := lightColor. 
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   191
        shadow := shadowColor.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   192
    ] ifFalse:[
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   193
        light := aGC lightColor. 
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   194
        shadow := aGC shadowColor.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   195
    ].
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   196
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   197
    aGC 
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   198
        drawEdgesForX:boxLeft y:boxTop width:boxWidth height:boxHeight level:(level ? width)
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   199
        shadow:shadow light:light
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   200
        halfShadow:nil halfLight:nil
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   201
        style:nil.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   202
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   203
    aGC paint:oldPaint.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   204
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   205
    "
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   206
     View new
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   207
        border:(BeveledBorder level:2 color:Color red);
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   208
        open.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   209
    "
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   210
    "
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   211
     View new
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   212
        border:(BeveledBorder level:4 color:Color red);
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   213
        open.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   214
    "
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   215
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   216
    "
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   217
     StandardSystemView new
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   218
        extent:200@200;
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   219
        add:(View new
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   220
                origin:(10@10) corner:0.9@0.9;
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   221
                border:(BeveledBorder width:4 color:Color red));
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   222
        open.
102f9d8b7c0e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5409
diff changeset
   223
    "
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
! !
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
!BeveledBorder class methodsFor:'documentation'!
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
version_CVS
7382
7f4cfe947539 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
   229
    ^ '$Header$'
5394
2721f96d5db9 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
! !
6718
f2cbb141e564 class: BeveledBorder
Claus Gittinger <cg@exept.de>
parents: 5460
diff changeset
   231