Button.st
author claus
Tue, 27 Jun 1995 04:24:41 +0200
changeset 131 208fa92f434d
parent 130 338e856bddc9
child 133 e58c7c979f33
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     1
"
4
88eb91574867 *** empty log message ***
claus
parents: 2
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
     3
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     4
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    11
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    12
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    13
Label subclass:#Button
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    14
       instanceVariableNames:'activeLogo passiveLogo
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    15
			      onLevel offLevel
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    16
			      disabledFgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    17
			      activeFgColor activeBgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    18
			      enteredFgColor enteredBgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    19
			      isReturnButton
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    20
			      shadowForm lightForm
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    21
			      formColor formShadowColor formLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    22
			      edgeStyle halfShadowColor halfLightColor'
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    23
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    24
      classVariableNames:'ReturnForm ReturnLightForm ReturnShadowForm 
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    25
		DefaultFont DefaultActiveLevel
95
7535cfca9509 *** empty log message ***
claus
parents: 88
diff changeset
    26
		DefaultPassiveLevel DefaultEdgeStyle DefaultBorderWidth
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    27
		DefaultForegroundColor DefaultBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    28
		DefaultDisabledForegroundColor DefaultDisabledBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    29
		DefaultEnteredForegroundColor DefaultEnteredBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    30
		DefaultActiveForegroundColor DefaultActiveBackgroundColor
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    31
		DefaultReturnButtonHasImage DefaultReturnButtonHasBorder
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    32
		DefaultShadowColor DefaultLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    33
		DefaultHalfShadowColor DefaultHalfLightColor'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    34
       poolDictionaries:''
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    35
       category:'Views-Interactors'
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    36
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    37
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    38
Button comment:'
4
88eb91574867 *** empty log message ***
claus
parents: 2
diff changeset
    39
COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    40
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    41
131
claus
parents: 130
diff changeset
    42
$Header: /cvs/stx/stx/libwidg/Button.st,v 1.25 1995-06-27 02:22:17 claus Exp $
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    43
'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    44
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    45
!Button class methodsFor:'documentation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    46
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    47
copyright
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    48
"
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    49
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    50
	      All Rights Reserved
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    51
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    52
 This software is furnished under a license and may be used
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    53
 only in accordance with the terms of that license and with the
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    54
 inclusion of the above copyright notice.   This software may not
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    55
 be provided or otherwise made available to, or used by, any
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    56
 other person.  No title to or ownership of the software is
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    57
 hereby transferred.
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    58
"
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    59
!
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    60
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    61
version
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    62
"
131
claus
parents: 130
diff changeset
    63
$Header: /cvs/stx/stx/libwidg/Button.st,v 1.25 1995-06-27 02:22:17 claus Exp $
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    64
"
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    65
!
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    66
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    67
documentation
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    68
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    69
    Buttons are Labels which do something when pressed/released.
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    70
    Since they inherit from Label, read the documentation on Labels to 
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    71
    see how color, layout, font, image or labelString are changed.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    72
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    73
    Actionblock operation:
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    74
      button has an actionBlock (actually, it has two: a pressAction and
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    75
      a releaseAction) which are evaluated.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    76
      The user of a button can define these actions via the #action,
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    77
      #pressAction or #releaseAction messages.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    78
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    79
    Model-View interaction:
118
claus
parents: 113
diff changeset
    80
      buttons with a model and a labelMsg react to changes of the aspect
claus
parents: 113
diff changeset
    81
      and perform a labelMsg-message on the model to aquire a new labelString.
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    82
      The model is should send 'self changed:<aspect>' if it wants the label to
118
claus
parents: 113
diff changeset
    83
      change and return a string from the labelSymbol-message.
claus
parents: 113
diff changeset
    84
      By default, the labelMsg is nil, therefore no update of the label is done.
claus
parents: 113
diff changeset
    85
      (this behavior is inherited from label, see documentation there)
claus
parents: 113
diff changeset
    86
claus
parents: 113
diff changeset
    87
      When pressed, the button sends a <change> message to the model.
claus
parents: 113
diff changeset
    88
      If the changeMsg is for a one-argument message, the current
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    89
      press-state is passed as argument (i.e. true if pressed, false if released).
118
claus
parents: 113
diff changeset
    90
      By default, the change-Message is #value: (for ST-80 compatibility).
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    91
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    92
	button model:aModel.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    93
	button aspect:aspectSymbol.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    94
	button change:changeSymbol.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    95
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    96
	model sends #changed:aspectSymbol
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    97
	---> button will redraw its label from value of model>>aspectSymbol
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    98
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
    99
	button changes state:
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   100
	---> button sends changeSymbolSymbol / changeSymbol:state
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   101
118
claus
parents: 113
diff changeset
   102
      By default (as inherited), the labelMsg is nil; therefore, buttons
claus
parents: 113
diff changeset
   103
      do not try to aquire a new labelString from the model.
claus
parents: 113
diff changeset
   104
      If you want this behavior, you must set labelMsg and aspectMsg
claus
parents: 113
diff changeset
   105
      as appropriate.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   106
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   107
    Instance variables:
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   108
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   109
      activeLogo              <StringOrImage> logo to show when active (pressed)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   110
      passiveLogo             <StringOrImage> logo to show when passive (released)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   111
					      default is nil for both, so the normal logo is used
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   112
					      (see superclass: Label)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   113
      onLevel                 <Integer>       level when pressed (3D only) (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   114
      offLevel                <Integer>       level when released (3D only) (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   115
      disabledFgColor         <Color>         color used to draw logo when disabled (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   116
      activeFgColor           <Color>         color to draw logo when pressed (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   117
      activeBgColor           <Color>         bg color when pressed (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   118
      enteredFgColor          <Color>         fg color to draw logo when cursor entered (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   119
      enteredBgColor          <Color>         bg color when cursor entered (default: depends on style)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   120
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   121
      isReturnButton          <Boolean>       true if this button is also activated by the
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   122
					      return key - if true, it will draw a return-bitmap 
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   123
					      in addition to the logo (default: false)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   124
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   125
      shadowForm              <Form>          form to display in addition to buttons label (returnbutton only)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   126
      lightForm               <Form>          light part of shadowForm (returnbutton only)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   127
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   128
      formColor               <Color>         color to draw form with (returnbutton only)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   129
      formShadowColor         <Color>         color for shadowing the form (3D only & return)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   130
      formLightColor          <Color>         color for lighting the form (3D only)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   131
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   132
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   133
    styleSheet parameters:
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   134
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   135
      buttonActiveLevel       <Integer>       level when on (ignored in 2D styles)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   136
      buttonPassiveLevel      <Integer>       level when off (ignored in 2D styles)
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   137
      buttonBorderWidth       <Integer>       default borderwidth
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   138
      buttonEdgeStyle         <Symbol>        style of edges (currently #soft or nil)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   139
      buttonFont              <Font>          font to use for textual labels
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   140
      buttonForegroundColor   <Color>         color to draw foreground pixels (i.e. the string)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   141
      buttonBackgroundColor   <Color>         color to draw background pixels
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   142
      buttonDisabledForegroundColor <Color>   same when disabled
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   143
      buttonDisabledBackgroundColor <Color>   same when disabled
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   144
      buttonEnteredForegroundColor  <Color>   same when mouse pointer is in
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   145
      buttonEnteredBackgroundColor  <Color>   same when mouse pointer is in
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   146
      buttonActiveForegroundColor   <Color>   same when button is active
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   147
      buttonActiveBackgroundColor   <Color>   same when button is active
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   148
      buttonShadowColor             <Color>   shadow color for edgaes (ignored in 2D styles)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   149
      buttonLightColor              <Color>   light color for edgaes (ignored in 2D styles)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   150
      buttonHalfShadowColor         <Color>   half shadow color; for soft edges only
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   151
      buttonHalfLightColor          <Color>   half light color; for soft edges only
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   152
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   153
      buttonReturnButtonHasImage    <Boolean> if true, return-buttons draw a return-key image
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   154
      buttonReturnButtonHasBorder   <Boolean> if true, return-buttons show a border
130
claus
parents: 128
diff changeset
   155
claus
parents: 128
diff changeset
   156
    See examples.
claus
parents: 128
diff changeset
   157
claus
parents: 128
diff changeset
   158
    See also: Toggle  CheckToggle  CheckBox
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   159
"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   160
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   161
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   162
examples 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   163
"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   164
    You dont have to normally care for all the internals 
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   165
    (they allow many variations though). The typical use is:
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   166
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   167
	b := Button label:'some logo' in:aView.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   168
	b action:[ .. things to do, when pressed ... ]
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   169
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   170
    for buttons with a string-label,
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   171
    and:
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   172
118
claus
parents: 113
diff changeset
   173
	b := Button label:someImage in:aView.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   174
	b action:[ .. things to do, when pressed ... ]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   175
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   176
    for buttons with a bitmap label.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   177
118
claus
parents: 113
diff changeset
   178
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   179
    Although you can specify a lot in a button,
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   180
    use the default in most applications.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   181
    As you specify more things in your program, 
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   182
    the styleSheet settings are more and more ignored.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   183
    Also, even though it might look fancy, colorful
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   184
    button panels are usually not a good GUI design;
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   185
    they will attract the users attention - possibly to things
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   186
    which are not worth it.
130
claus
parents: 128
diff changeset
   187
    Finally, if you use fancy colors, always thing of those without
claus
parents: 128
diff changeset
   188
    color displays - the styleSheet allows those people to adjust things,
claus
parents: 128
diff changeset
   189
    while hard-coded colors cannot be fixed without changing the code.
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   190
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   191
    default settings:
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   192
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   193
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   194
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   195
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   196
      top extent:100@100.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   197
118
claus
parents: 113
diff changeset
   198
      b := Button in:top.
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   199
      b label:'hello'.
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   200
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   201
      top open.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   202
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   203
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   204
    there is also a combined instance creation message:
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   205
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   206
      |top b|
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   207
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   208
      top := StandardSystemView new.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   209
      top extent:100@100.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   210
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   211
      b := Button label:'hello' action:[Transcript flash] in:top.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   212
      top open.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   213
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   214
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   215
    changing colors:
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   216
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   217
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   218
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   219
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   220
      top extent:100@100.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   221
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   222
      b := Button label:'hello' in:top.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   223
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   224
      b activeForegroundColor:(Color white).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   225
      b activeBackgroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   226
      top open.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   227
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   228
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   229
    changing more colors:
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   230
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   231
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   232
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   233
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   234
      top extent:100@100.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   235
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   236
      b := Button label:'hello' in:top.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   237
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   238
      b enteredForegroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   239
      b enteredBackgroundColor:(b backgroundColor).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   240
      b activeForegroundColor:(Color white).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   241
      b activeBackgroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   242
      top open.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   243
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   244
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   245
    button with an image and different colors:
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   246
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   247
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   248
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   249
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   250
      top extent:100@100.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   251
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   252
      b := Button in:top.
118
claus
parents: 113
diff changeset
   253
      b label:(Image fromFile:'bitmaps/SBrowser.xbm').
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   254
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   255
      b enteredForegroundColor:(Color green darkened).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   256
      b enteredBackgroundColor:(b backgroundColor).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   257
      b activeForegroundColor:(Color white).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   258
      b activeBackgroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   259
      top open.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   260
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   261
118
claus
parents: 113
diff changeset
   262
    changing the image when pressed:
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   263
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   264
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   265
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   266
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   267
      top extent:100@100.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   268
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   269
      b := Button in:top.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   270
      b passiveLogo:(Image fromFile:'bitmaps/SBrowser.xbm').
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   271
      b activeLogo:(Image fromFile:'bitmaps/CBrowser.xbm').
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   272
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   273
      b enteredForegroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   274
      b enteredBackgroundColor:(b backgroundColor).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   275
      b activeForegroundColor:(Color white).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   276
      b activeBackgroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   277
      top open.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   278
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   279
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   280
    well, even that is possible (but you should NEVER do it):
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   281
    (notice the changing size and the resulting problem when
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   282
     pressed near the bottom, since the button thinks the pointer
118
claus
parents: 113
diff changeset
   283
     leaves the view and changes back and forth ...)
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   284
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   285
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   286
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   287
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   288
      top extent:100@100.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   289
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   290
      b := Button in:top.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   291
      b passiveLogo:(Image fromFile:'bitmaps/SmalltalkX.xbm').
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   292
      b activeLogo:#('start') asStringCollection.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   293
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   294
      b enteredForegroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   295
      b enteredBackgroundColor:(b backgroundColor).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   296
      b activeForegroundColor:(Color white).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   297
      b activeBackgroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   298
      top open.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   299
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   300
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   301
    same as above, with frozen size to avoid the problem. 
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   302
    (make certain, that the size is ok for all possible logos):
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   303
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   304
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   305
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   306
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   307
      top extent:100@100.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   308
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   309
      b := Button in:top.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   310
      b passiveLogo:(Image fromFile:'bitmaps/SmalltalkX.xbm').
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   311
      b activeLogo:#('go') asStringCollection.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   312
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   313
      b enteredForegroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   314
      b enteredBackgroundColor:(b backgroundColor).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   315
      b activeForegroundColor:(Color white).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   316
      b activeBackgroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   317
      b sizeFixed:true.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   318
      top open.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   319
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   320
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   321
    more playing with colors:
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   322
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   323
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   324
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   325
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   326
      top extent:100@100.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   327
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   328
      b := Button in:top.
130
claus
parents: 128
diff changeset
   329
      b logo:(Image fromFile:'bitmaps/SmalltalkX.xbm').
claus
parents: 128
diff changeset
   330
      b action:[Transcript flash].
claus
parents: 128
diff changeset
   331
      b foregroundColor:(Color red:0 green:80 blue:20) darkened.
claus
parents: 128
diff changeset
   332
      b backgroundColor:(Color grey:10).
claus
parents: 128
diff changeset
   333
      b enteredForegroundColor:(Color red).
claus
parents: 128
diff changeset
   334
      b activeForegroundColor:(Color red).
claus
parents: 128
diff changeset
   335
      b activeBackgroundColor:(Color grey:10).
claus
parents: 128
diff changeset
   336
      top open.
claus
parents: 128
diff changeset
   337
claus
parents: 128
diff changeset
   338
claus
parents: 128
diff changeset
   339
    more playing with colors:
claus
parents: 128
diff changeset
   340
claus
parents: 128
diff changeset
   341
      |top b|
claus
parents: 128
diff changeset
   342
claus
parents: 128
diff changeset
   343
      top := StandardSystemView new.
claus
parents: 128
diff changeset
   344
      top extent:100@100.
claus
parents: 128
diff changeset
   345
claus
parents: 128
diff changeset
   346
      b := Button in:top.
claus
parents: 128
diff changeset
   347
      b logo:(Image fromFile:'bitmaps/SmalltalkX.xbm').
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   348
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   349
      b foregroundColor:(Color red:0 green:80 blue:20) darkened.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   350
      b backgroundColor:(Color grey:10).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   351
      b enteredBackgroundColor:(Color grey:20).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   352
      b activeForegroundColor:(Color red).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   353
      b activeBackgroundColor:(Color grey:20).
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   354
      top open.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   355
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   356
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   357
    fire on press (buttons in scrollbars do this, while normal buttons
130
claus
parents: 128
diff changeset
   358
    fire on release.
claus
parents: 128
diff changeset
   359
    (to give the user a chance to change her mind
claus
parents: 128
diff changeset
   360
     and leave the button, you should not change the default behavior):
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   361
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   362
      |top b|
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   363
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   364
      top := StandardSystemView new.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   365
      top extent:100@100.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   366
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   367
      b := Button label:'hello' in:top.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   368
      b controller beTriggerOnDown.
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   369
      b action:[Transcript flash].
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   370
      top open.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   371
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   372
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   373
    To implement fun buttons (for games, show-demos etc.), you can
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   374
    access all internal parameters (and not take the viewStyle defaults)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   375
    as in:
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   376
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   377
	|b granite light shadow|
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   378
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   379
	b := Button label:'a nice one ?'.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   380
	granite := Image fromFile:'bitmaps/granite_small.tiff'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   381
	light := granite lightened.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   382
	shadow := granite darkened.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   383
	b backgroundColor:granite.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   384
	b foregroundColor:Color white.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   385
	b shadowColor:shadow.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   386
	b lightColor:light.
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   387
	b enteredBackgroundColor:light.
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   388
	b enteredForegroundColor:Color black.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   389
	b onLevel:-3; offLevel:5.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   390
	b extent:(200 @ 50).
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   391
	b open
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   392
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   393
    However, in your application, you may want to read those bitmaps only once
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   394
    during startup and cache them for later reuse in some class variable
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   395
    (reading, lightning & darkening of images is a bit slow)
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   396
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   397
118
claus
parents: 113
diff changeset
   398
    ST/X Buttons allow simulation of the ST-80 MVC way of interacting.
claus
parents: 113
diff changeset
   399
    To do so, instead (or in addition) to defining actionBlocks, set the
127
claus
parents: 125
diff changeset
   400
    buttons model to have this be informed (in addition):
118
claus
parents: 113
diff changeset
   401
claus
parents: 113
diff changeset
   402
    Model-View interaction (ST-80 style):
claus
parents: 113
diff changeset
   403
    (have a look at the models values in the inspector, as the toggles change)
claus
parents: 113
diff changeset
   404
claus
parents: 113
diff changeset
   405
      |bool1 bool2 b panel top|
claus
parents: 113
diff changeset
   406
claus
parents: 113
diff changeset
   407
      bool1 := ValueHolder newBoolean.
claus
parents: 113
diff changeset
   408
      bool2 := ValueHolder newBoolean value:true.
claus
parents: 113
diff changeset
   409
claus
parents: 113
diff changeset
   410
      top := StandardSystemView new.
claus
parents: 113
diff changeset
   411
      top extent:200@100.
claus
parents: 113
diff changeset
   412
claus
parents: 113
diff changeset
   413
      panel := HorizontalPanelView 
claus
parents: 113
diff changeset
   414
		origin:0.0 @ 0.0 corner:1.0 @ 50 in:top.
claus
parents: 113
diff changeset
   415
claus
parents: 113
diff changeset
   416
      b := Toggle label:'eat me' in:panel.
claus
parents: 113
diff changeset
   417
      b model:bool1.
claus
parents: 113
diff changeset
   418
claus
parents: 113
diff changeset
   419
      b := Toggle label:'drink me' in:panel.
claus
parents: 113
diff changeset
   420
      b model:bool2.
claus
parents: 113
diff changeset
   421
claus
parents: 113
diff changeset
   422
      top open.
claus
parents: 113
diff changeset
   423
      bool1 inspect.
claus
parents: 113
diff changeset
   424
      bool2 inspect.
claus
parents: 113
diff changeset
   425
claus
parents: 113
diff changeset
   426
    Using a PluggableAdaptor (ST-80 style):
claus
parents: 113
diff changeset
   427
    (notice, that this is almost what ST/X buttons did originally,
127
claus
parents: 125
diff changeset
   428
     therefore, you may want use actionBlocks right away ...)
118
claus
parents: 113
diff changeset
   429
claus
parents: 113
diff changeset
   430
      |adaptor1 adaptor2 b panel top|
claus
parents: 113
diff changeset
   431
claus
parents: 113
diff changeset
   432
      adaptor1 := PluggableAdaptor new 
130
claus
parents: 128
diff changeset
   433
			getBlock:[:m | false] 
131
claus
parents: 130
diff changeset
   434
			putBlock:[:m :v | Transcript showCr:'eat']
118
claus
parents: 113
diff changeset
   435
			updateBlock:nil.
claus
parents: 113
diff changeset
   436
      adaptor2 := PluggableAdaptor new 
130
claus
parents: 128
diff changeset
   437
			getBlock:[:m | false] 
131
claus
parents: 130
diff changeset
   438
			putBlock:[:m :v | Transcript showCr:'drink']
118
claus
parents: 113
diff changeset
   439
			updateBlock:nil.
claus
parents: 113
diff changeset
   440
claus
parents: 113
diff changeset
   441
      top := StandardSystemView new.
claus
parents: 113
diff changeset
   442
      top extent:200@100.
claus
parents: 113
diff changeset
   443
claus
parents: 113
diff changeset
   444
      panel := HorizontalPanelView 
claus
parents: 113
diff changeset
   445
		origin:0.0 @ 0.0 corner:1.0 @ 50 in:top.
claus
parents: 113
diff changeset
   446
130
claus
parents: 128
diff changeset
   447
      b := Button label:'eat me' in:panel.
118
claus
parents: 113
diff changeset
   448
      b model:adaptor1.
claus
parents: 113
diff changeset
   449
130
claus
parents: 128
diff changeset
   450
      b := Button label:'drink me' in:panel.
118
claus
parents: 113
diff changeset
   451
      b model:adaptor2.
claus
parents: 113
diff changeset
   452
claus
parents: 113
diff changeset
   453
      top open.
claus
parents: 113
diff changeset
   454
claus
parents: 113
diff changeset
   455
claus
parents: 113
diff changeset
   456
    as a reminder, the corresponding ST/X setup is:
claus
parents: 113
diff changeset
   457
claus
parents: 113
diff changeset
   458
      |b panel top|
claus
parents: 113
diff changeset
   459
claus
parents: 113
diff changeset
   460
      top := StandardSystemView new.
claus
parents: 113
diff changeset
   461
      top extent:200@100.
claus
parents: 113
diff changeset
   462
claus
parents: 113
diff changeset
   463
      panel := HorizontalPanelView 
claus
parents: 113
diff changeset
   464
		origin:0.0 @ 0.0 corner:1.0 @ 50 in:top.
claus
parents: 113
diff changeset
   465
130
claus
parents: 128
diff changeset
   466
      b := Button label:'eat me' in:panel.
131
claus
parents: 130
diff changeset
   467
      b action:[Transcript showCr:'eat'].
118
claus
parents: 113
diff changeset
   468
130
claus
parents: 128
diff changeset
   469
      b := Button label:'drink me' in:panel.
131
claus
parents: 130
diff changeset
   470
      b action:[Transcript showCr:'drink'].
118
claus
parents: 113
diff changeset
   471
claus
parents: 113
diff changeset
   472
      top open.
claus
parents: 113
diff changeset
   473
claus
parents: 113
diff changeset
   474
130
claus
parents: 128
diff changeset
   475
    accessing multiple aspects of a complex model
claus
parents: 128
diff changeset
   476
    (using a plug here to simulate that model ...)
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   477
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   478
      |myModel b panel top|
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   479
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   480
      myModel := Plug new.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   481
      myModel respondTo:#grow with:[top extent:200@300].
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   482
      myModel respondTo:#shrink with:[top extent:200@100].
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   483
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   484
      top := StandardSystemView new.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   485
      top extent:200@100.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   486
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   487
      panel := HorizontalPanelView 
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   488
		origin:0.0 @ 0.0  
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   489
		corner:1.0 @ 50
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   490
		in:top.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   491
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   492
      b := Button label:'eat me' in:panel.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   493
      b model:myModel; change:#grow.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   494
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   495
      b := Button label:'drink me' in:panel.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   496
      b model:myModel; change:#shrink.
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   497
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   498
      top open.
118
claus
parents: 113
diff changeset
   499
113
fdd18cfff57e *** empty log message ***
claus
parents: 97
diff changeset
   500
130
claus
parents: 128
diff changeset
   501
    aquiring the label from the model
claus
parents: 128
diff changeset
   502
    (this functionality is inherited from Label)
claus
parents: 128
diff changeset
   503
claus
parents: 128
diff changeset
   504
      |myModel b panel top currentLabel|
claus
parents: 128
diff changeset
   505
claus
parents: 128
diff changeset
   506
      currentLabel := 'foo'.
claus
parents: 128
diff changeset
   507
claus
parents: 128
diff changeset
   508
      myModel := Plug new.
claus
parents: 128
diff changeset
   509
      myModel respondTo:#getLabel with:[currentLabel].
claus
parents: 128
diff changeset
   510
      myModel respondTo:#b0Pressed with:[].
claus
parents: 128
diff changeset
   511
      myModel respondTo:#b1Pressed with:[currentLabel := 'bar'.
claus
parents: 128
diff changeset
   512
					 myModel changed:#labelAspect].
claus
parents: 128
diff changeset
   513
      myModel respondTo:#b2Pressed with:[currentLabel := 'foo'.
claus
parents: 128
diff changeset
   514
					 myModel changed:#labelAspect].
claus
parents: 128
diff changeset
   515
claus
parents: 128
diff changeset
   516
      top := StandardSystemView new.
claus
parents: 128
diff changeset
   517
      top extent:300@100.
claus
parents: 128
diff changeset
   518
claus
parents: 128
diff changeset
   519
      panel := HorizontalPanelView 
claus
parents: 128
diff changeset
   520
		origin:0.0 @ 0.0  
claus
parents: 128
diff changeset
   521
		corner:1.0 @ 50
claus
parents: 128
diff changeset
   522
		in:top.
claus
parents: 128
diff changeset
   523
claus
parents: 128
diff changeset
   524
      b := Button label:'press me' in:panel.
claus
parents: 128
diff changeset
   525
      b model:myModel; change:#b0Pressed; 
claus
parents: 128
diff changeset
   526
	labelMessage:#getLabel; aspect:#labelAspect.
claus
parents: 128
diff changeset
   527
claus
parents: 128
diff changeset
   528
      b := Button label:'press for bar' in:panel.
claus
parents: 128
diff changeset
   529
      b model:myModel; change:#b1Pressed.
claus
parents: 128
diff changeset
   530
claus
parents: 128
diff changeset
   531
      b := Button label:'press for foo' in:panel.
claus
parents: 128
diff changeset
   532
      b model:myModel; change:#b2Pressed.
claus
parents: 128
diff changeset
   533
claus
parents: 128
diff changeset
   534
      top open.
claus
parents: 128
diff changeset
   535
88
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   536
    see 'doc/coding-examples' and 'doc/misc/quick_view_intro.doc' 
7560534e9026 *** empty log message ***
claus
parents: 82
diff changeset
   537
    for more variations on this theme.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   538
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   539
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   540
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   541
!Button class methodsFor:'defaults'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   542
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   543
updateStyleCache
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   544
    |defaultLevel|
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   545
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   546
    StyleSheet is3D ifTrue:[
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   547
	defaultLevel := 1.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   548
    ] ifFalse:[
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   549
	defaultLevel := 0
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   550
    ].
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   551
    DefaultActiveLevel := StyleSheet at:'buttonActiveLevel' default:(defaultLevel negated).
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   552
    DefaultPassiveLevel := StyleSheet at:'buttonPassiveLevel' default:defaultLevel.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   553
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   554
    DefaultEdgeStyle := StyleSheet at:'buttonEdgeStyle'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   555
    DefaultFont := StyleSheet fontAt:'buttonFont'.
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   556
    DefaultBorderWidth := StyleSheet at:'buttonBorderWidth'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   557
    DefaultForegroundColor := StyleSheet colorAt:'buttonForegroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   558
    DefaultBackgroundColor := StyleSheet colorAt:'buttonBackgroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   559
    DefaultDisabledForegroundColor := StyleSheet colorAt:'buttonDisabledForegroundColor' default:Color grey.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   560
    DefaultDisabledBackgroundColor := StyleSheet colorAt:'buttonDisabledBackgroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   561
    DefaultEnteredForegroundColor := StyleSheet colorAt:'buttonEnteredForegroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   562
    DefaultEnteredBackgroundColor := StyleSheet colorAt:'buttonEnteredBackgroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   563
    DefaultActiveForegroundColor := StyleSheet colorAt:'buttonActiveForegroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   564
    DefaultActiveBackgroundColor := StyleSheet colorAt:'buttonActiveBackgroundColor'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   565
    DefaultReturnButtonHasImage := StyleSheet at:'buttonReturnButtonHasImage' default:true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   566
    DefaultReturnButtonHasBorder := StyleSheet at:'buttonReturnButtonHasBorder' default:false.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   567
    DefaultShadowColor := StyleSheet colorAt:'buttonShadowColor'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   568
    DefaultLightColor := StyleSheet colorAt:'buttonLightColor'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   569
    DefaultHalfShadowColor := StyleSheet colorAt:'buttonHalfShadowColor'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   570
    DefaultHalfLightColor := StyleSheet colorAt:'buttonHalfLightColor'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   571
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   572
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   573
returnFormOn:aDevice
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   574
    "return the form used for the return arrow in non-3D;
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   575
     cache the one for Display for the next round."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   576
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   577
    |f|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   578
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   579
    (ReturnForm notNil and:[aDevice == ReturnForm device]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   580
	^ ReturnForm
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   581
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   582
    f := Form fromFile:'Return.xbm' resolution:100 on:aDevice.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   583
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   584
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   585
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   586
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   587
						 2r00000000 2r00000011 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   588
						 2r00000001 2r10000011 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   589
						 2r00000011 2r10000011 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   590
						 2r00000111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   591
						 2r00001111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   592
						 2r00011111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   593
						 2r00001111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   594
						 2r00000111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   595
						 2r00000011 2r10000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   596
						 2r00000001 2r10000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   597
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   598
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   599
						 2r00000000 2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   600
					      on:aDevice
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   601
    ].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   602
    ReturnForm := f.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   603
    ^ f
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   604
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   605
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   606
returnShadowFormOn:aDevice
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   607
    "return the form used for the return arrow shadow pixels (3D only);
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   608
     cache the one for Display for the next round."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   609
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   610
    |f|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   611
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   612
    (ReturnShadowForm notNil and:[aDevice == ReturnShadowForm device]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   613
	^ ReturnShadowForm
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   614
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   615
    f := Form fromFile:'ReturnShadow.xbm' resolution:100 on:aDevice.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   616
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   617
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   618
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   619
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   620
						 2r00000000 2r00000011 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   621
						 2r00000001 2r10000010 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   622
						 2r00000010 2r10000010 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   623
						 2r00000100 2r11111110 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   624
						 2r00001000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   625
						 2r00010000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   626
						 2r00001000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   627
						 2r00000100 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   628
						 2r00000010 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   629
						 2r00000001 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   630
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   631
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   632
						 2r00000000 2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   633
					      on:aDevice
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   634
    ].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   635
    ReturnShadowForm := f.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   636
    ^ f
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   637
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   638
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   639
returnLightFormOn:aDevice
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   640
    "return the form used for the return arrow light pixels (3D only);
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   641
     cache the one for Display for the next round"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   642
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   643
    |f|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   644
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   645
    (ReturnLightForm notNil and:[aDevice == ReturnLightForm device]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   646
	^ ReturnLightForm
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   647
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   648
    f := Form fromFile:'ReturnLight.xbm' resolution:100 on:aDevice.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   649
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   650
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   651
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   652
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   653
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   654
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   655
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   656
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   657
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   658
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   659
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   660
						 2r00000000 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   661
						 2r00000000 2r10000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   662
						 2r00000000 2r10000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   663
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   664
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   665
						 2r00000000 2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   666
					      on:aDevice
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   667
    ].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   668
    ReturnLightForm := f.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   669
    ^ f
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   670
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   671
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   672
!Button class methodsFor:'instance creation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   673
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   674
label:aLabel action:aBlock in:aView
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   675
    "create and return a new Button with text-label, aString
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   676
     and pressAction, aBlock.  Button is placed into aView."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   677
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   678
    ^ ((self in:aView) label:aLabel) action:aBlock
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   679
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   680
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   681
form:aForm action:aBlock in:aView
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   682
    "create and return a new Button with icon-label, aForm
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   683
     and pressAction, aBlock.  Button is placed into aView."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   684
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   685
    ^ ((self in:aView) form:aForm) action:aBlock
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   686
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   687
118
claus
parents: 113
diff changeset
   688
okButton
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   689
    "since ok-buttons are very common, here is a convenient
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   690
     method to create one ..."
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   691
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   692
    |aButton|
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   693
118
claus
parents: 113
diff changeset
   694
    aButton := Button label:(self classResources at:'ok').
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   695
    aButton cursor:(Cursor thumbsUp).
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   696
    aButton isReturnButton:true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   697
    ^ aButton
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   698
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   699
118
claus
parents: 113
diff changeset
   700
abortButton
claus
parents: 113
diff changeset
   701
    "since abort-buttons are very common, here is a convenient
claus
parents: 113
diff changeset
   702
     method to create one ..."
claus
parents: 113
diff changeset
   703
claus
parents: 113
diff changeset
   704
    |aButton|
claus
parents: 113
diff changeset
   705
claus
parents: 113
diff changeset
   706
    aButton := Button label:(self classResources at:'abort').
claus
parents: 113
diff changeset
   707
    aButton cursor:(Cursor thumbsDown).
claus
parents: 113
diff changeset
   708
    ^ aButton
claus
parents: 113
diff changeset
   709
!
claus
parents: 113
diff changeset
   710
claus
parents: 113
diff changeset
   711
okButtonIn:aView
claus
parents: 113
diff changeset
   712
    "since ok-buttons are very common, here is a convenient
claus
parents: 113
diff changeset
   713
     method to create one ..."
claus
parents: 113
diff changeset
   714
claus
parents: 113
diff changeset
   715
    |b|
claus
parents: 113
diff changeset
   716
claus
parents: 113
diff changeset
   717
    aView addSubView:(b := self okButton).
claus
parents: 113
diff changeset
   718
    ^ b
claus
parents: 113
diff changeset
   719
!
claus
parents: 113
diff changeset
   720
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   721
abortButtonIn:aView
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   722
    "since abort-buttons are very common, here is a convenient
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   723
     method to create one ..."
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   724
118
claus
parents: 113
diff changeset
   725
    |b|
claus
parents: 113
diff changeset
   726
claus
parents: 113
diff changeset
   727
    aView addSubView:(b := self abortButton). 
claus
parents: 113
diff changeset
   728
    ^ b
claus
parents: 113
diff changeset
   729
!
claus
parents: 113
diff changeset
   730
claus
parents: 113
diff changeset
   731
toggle
claus
parents: 113
diff changeset
   732
    "ST-80 compatibility: create & return a new toggle."
claus
parents: 113
diff changeset
   733
claus
parents: 113
diff changeset
   734
    ^ Toggle new
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   735
118
claus
parents: 113
diff changeset
   736
    "
claus
parents: 113
diff changeset
   737
     Button toggle label:'press me';
claus
parents: 113
diff changeset
   738
		   model:((PluggableAdaptor on:(Point new))
claus
parents: 113
diff changeset
   739
			    getSelector:#x putSelector:#x:)
claus
parents: 113
diff changeset
   740
    "
claus
parents: 113
diff changeset
   741
    "this is the same as"
claus
parents: 113
diff changeset
   742
    "
claus
parents: 113
diff changeset
   743
     Toggle new label:'press me';
claus
parents: 113
diff changeset
   744
		model:((PluggableAdaptor on:(Point new))
claus
parents: 113
diff changeset
   745
			    getSelector:#x putSelector:#x:)
claus
parents: 113
diff changeset
   746
    "
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   747
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   748
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   749
!Button methodsFor:'initialization'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   750
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   751
initialize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   752
    super initialize.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   753
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   754
    isReturnButton := false.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   755
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   756
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   757
initStyle
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   758
    |hasGreyscales nm|
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   759
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   760
    super initStyle.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   761
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   762
    DefaultFont notNil ifTrue:[font := DefaultFont on:device].
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   763
    DefaultBorderWidth notNil ifTrue:[borderWidth := DefaultBorderWidth].
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   764
    DefaultForegroundColor notNil ifTrue:[fgColor := DefaultForegroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   765
    DefaultBackgroundColor notNil ifTrue:[bgColor := DefaultBackgroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   766
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   767
    edgeStyle := DefaultEdgeStyle.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   768
    onLevel := DefaultActiveLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   769
    offLevel := DefaultPassiveLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   770
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   771
    DefaultDisabledForegroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   772
	disabledFgColor := DefaultDisabledForegroundColor on:device
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   773
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   774
	disabledFgColor := fgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   775
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   776
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   777
    DefaultEnteredForegroundColor notNil ifTrue:[enteredFgColor := DefaultEnteredForegroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   778
    DefaultEnteredBackgroundColor notNil ifTrue:[enteredBgColor := DefaultEnteredBackgroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   779
    DefaultActiveForegroundColor notNil ifTrue:[activeFgColor := DefaultActiveForegroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   780
    DefaultActiveBackgroundColor notNil ifTrue:[activeBgColor := DefaultActiveBackgroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   781
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   782
    DefaultShadowColor notNil ifTrue:[shadowColor := DefaultShadowColor on:device].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   783
    DefaultLightColor notNil ifTrue:[lightColor := DefaultLightColor on:device].
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   784
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   785
    shadowColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   786
	shadowColor := Black.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   787
    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   788
    lightColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   789
	lightColor := White.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   790
    ].
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   791
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   792
    hasGreyscales := device hasGreyscales.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   793
    (edgeStyle == #soft) ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   794
	DefaultHalfShadowColor notNil ifTrue:[halfShadowColor := DefaultHalfShadowColor on:device].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   795
	DefaultHalfLightColor notNil ifTrue:[halfLightColor := DefaultHalfLightColor on:device].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   796
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   797
	halfShadowColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   798
"/            hasGreyscales ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   799
"/                halfShadowColor := Color darkGrey
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   800
"/            ] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   801
"/                halfShadowColor := shadowColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   802
"/            ]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   803
	    halfShadowColor := shadowColor lightened
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   804
	]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   805
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   806
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   807
    "
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   808
     actually, the stuf below should not be needed
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   809
     - the styleSheet should provide values for nonGreyscale displays too
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   810
    "
130
claus
parents: 128
diff changeset
   811
    nm := styleSheet name.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   812
    (nm == #iris) ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   813
	hasGreyscales ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   814
	    DefaultEnteredBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   815
		enteredBgColor := bgColor lightened "Color lightGrey".
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   816
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   817
	    DefaultActiveBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   818
		activeBgColor := enteredBgColor.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   819
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   820
	    DefaultActiveForegroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   821
		activeFgColor := enteredFgColor.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   822
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   823
	] ifFalse:[
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   824
	    DefaultEnteredBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   825
		enteredBgColor := Color veryLightGrey.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   826
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   827
	    DefaultActiveBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   828
		activeBgColor := Black.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   829
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   830
	    DefaultActiveForegroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   831
		activeFgColor := White.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   832
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   833
	].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   834
    ] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   835
	nm == #motif ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   836
	    lightColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   837
		lightColor := bgColor lightened
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   838
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   839
"/            hasGreyscales ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   840
"/                lightColor := Color lightGrey
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   841
"/            ]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   842
	] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   843
	    nm == #st80 ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   844
		hasGreyscales ifTrue:[
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   845
		    DefaultActiveForegroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   846
			activeFgColor := fgColor.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   847
		    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   848
		    DefaultActiveBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   849
			activeBgColor := bgColor darkened.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   850
		    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   851
		] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   852
		    DefaultActiveForegroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   853
			activeFgColor := White.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   854
		    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   855
		    DefaultActiveBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   856
			activeBgColor := Black
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   857
		    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   858
		]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   859
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   860
	]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   861
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   862
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   863
    offLevel ~~ level ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   864
	self level:offLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   865
	margin := (onLevel abs) max:(offLevel abs).
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   866
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   867
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   868
    DefaultReturnButtonHasImage ifTrue:[
130
claus
parents: 128
diff changeset
   869
	(styleSheet is3D and:[hasGreyscales]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   870
	    shadowForm := self class returnShadowFormOn:device.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   871
	    lightForm := self class returnLightFormOn:device.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   872
	    formColor := viewBackground.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   873
	    formShadowColor := shadowColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   874
	    formLightColor := lightColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   875
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   876
	    shadowForm := self class returnFormOn:device.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   877
	    formColor := Black
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   878
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   879
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   880
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   881
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   882
initCursor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   883
    "set up a hand cursor"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   884
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   885
    cursor := Cursor hand
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   886
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   887
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   888
initEvents
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   889
    super initEvents.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   890
    self enableEnterLeaveEvents
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   891
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   892
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   893
realize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   894
    super realize.
118
claus
parents: 113
diff changeset
   895
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   896
    controller active:false.
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   897
    controller entered:false.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   898
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   899
    fgColor := fgColor on:device.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   900
    bgColor := bgColor on:device.
18
66bf62e27141 *** empty log message ***
claus
parents: 6
diff changeset
   901
    formColor notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   902
	formColor := formColor on:device.
18
66bf62e27141 *** empty log message ***
claus
parents: 6
diff changeset
   903
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   904
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   905
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   906
reinitialize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   907
    super reinitialize.
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   908
    controller notNil ifTrue:[
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   909
	controller active:false.
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   910
	controller entered:false.
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   911
    ]
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   912
!
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   913
95
7535cfca9509 *** empty log message ***
claus
parents: 88
diff changeset
   914
defaultControllerClass
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
   915
    ^ ButtonController
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   916
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   917
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   918
!Button methodsFor:'queries'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   919
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   920
is3D
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   921
    "return true, if the receiver is a 3D style view"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   922
130
claus
parents: 128
diff changeset
   923
    styleSheet name == #mswindows ifTrue:[^ true].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   924
    ^ super is3D
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   925
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   926
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   927
isReturnButton
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   928
    "return true, if this is a return button"
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   929
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   930
    ^ isReturnButton
127
claus
parents: 125
diff changeset
   931
!
claus
parents: 125
diff changeset
   932
claus
parents: 125
diff changeset
   933
isOn
claus
parents: 125
diff changeset
   934
    "return true, if this button is currently pressed"
claus
parents: 125
diff changeset
   935
claus
parents: 125
diff changeset
   936
    ^ controller pressed
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   937
! !
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   938
127
claus
parents: 125
diff changeset
   939
!Button methodsFor:'accessing-look'!
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   940
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   941
isReturnButton:aBoolean
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   942
    "show/dont show a return-key image after the label"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   943
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   944
    isReturnButton ~~ aBoolean ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   945
	DefaultReturnButtonHasBorder ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   946
	    self borderWidth:(aBoolean ifTrue:[1] ifFalse:[0])
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   947
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   948
	isReturnButton := aBoolean.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   949
	self newLayout
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   950
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   951
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   952
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   953
onLevel:aNumber
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   954
    "set the level of the button when pressed (i.e. how deep)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   955
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   956
    onLevel := aNumber.
128
claus
parents: 127
diff changeset
   957
    (controller notNil
claus
parents: 127
diff changeset
   958
    and:[controller pressed]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   959
	self level:onLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   960
	margin := onLevel abs max:offLevel abs.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   961
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   962
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   963
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   964
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   965
onLevel
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   966
    "return the level of the button when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   967
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   968
    ^ onLevel
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   969
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   970
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   971
offLevel:aNumber
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   972
    "set the level of the button when not pressed (i.e. how high)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   973
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   974
    offLevel := aNumber.
128
claus
parents: 127
diff changeset
   975
    (controller notNil
claus
parents: 127
diff changeset
   976
    and:[controller pressed not]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   977
	self level:offLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   978
	margin := onLevel abs max:offLevel abs.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   979
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   980
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   981
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   982
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   983
offLevel
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   984
    "return the level of the button when released"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   985
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   986
    ^ offLevel
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   987
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   988
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   989
edgeStyle:aSymbol
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   990
    "set the edgestyle - currently only #soft or nil"
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   991
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   992
    edgeStyle := aSymbol
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   993
!
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   994
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   995
activeLogo:anImageOrString
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   996
    "define the logo to be displayed while active -
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   997
     this is optional; the default is to display the same
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   998
     (logo) in both pressed and released states."
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   999
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1000
    activeLogo := anImageOrString.
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1001
    controller pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1002
	self logo:anImageOrString
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1003
    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1004
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1005
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1006
passiveLogo:anImageOrString
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1007
    "define the logo to be displayed while inactive -
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1008
     this is optional; the default is to display the same
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1009
     (logo) in both pressed and released states."
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1010
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1011
    passiveLogo := anImageOrString.
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1012
    controller pressed ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1013
	self logo:anImageOrString
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1014
    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1015
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1016
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1017
activeForegroundColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1018
    "return the foreground color to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1019
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1020
    ^ activeFgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1021
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1022
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1023
activeForegroundColor:aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1024
    "set the foreground color to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1025
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1026
    activeFgColor := aColor.
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1027
    self redrawIfPressed
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1028
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1029
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1030
activeBackgroundColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1031
    "return the background color to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1032
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1033
    ^ activeBgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1034
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1035
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1036
activeBackgroundColor:aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1037
    "set the background color to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1038
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1039
    activeBgColor := aColor.
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1040
    self redrawIfPressed
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1041
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1042
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1043
activeForegroundColor:fgColor backgroundColor:bgColor
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1044
    "set both fg and bg colors to be used when pressed"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1045
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1046
    activeFgColor := fgColor.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1047
    activeBgColor := bgColor.
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1048
    self redrawIfPressed
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1049
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1050
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1051
enteredForegroundColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1052
    "return the foreground color to be used when the mouse
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1053
     pointer enters the button area"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1054
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1055
    ^ enteredFgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1056
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1057
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1058
enteredForegroundColor:aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1059
    "set the foreground color to be used when the mouse
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1060
     pointer enters the button area"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1061
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1062
    enteredFgColor := aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1063
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1064
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1065
enteredBackgroundColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1066
    "return the background color to be used when the mouse
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1067
     pointer enters the button area"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1068
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1069
    ^ enteredBgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1070
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1071
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1072
enteredBackgroundColor:aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1073
    "set the background color to be used when the mouse
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1074
     pointer enters the button area"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1075
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1076
    enteredBgColor := aColor
127
claus
parents: 125
diff changeset
  1077
!
claus
parents: 125
diff changeset
  1078
claus
parents: 125
diff changeset
  1079
disabledForegroundColor
claus
parents: 125
diff changeset
  1080
    "return the foreground color used when the button is disabled"
claus
parents: 125
diff changeset
  1081
claus
parents: 125
diff changeset
  1082
    ^ disabledFgColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1083
! !
127
claus
parents: 125
diff changeset
  1084
    
claus
parents: 125
diff changeset
  1085
!Button methodsFor:'accessing-behavior'!
claus
parents: 125
diff changeset
  1086
claus
parents: 125
diff changeset
  1087
pressAction
claus
parents: 125
diff changeset
  1088
    "return the pressAction; thats the block which gets evaluated
claus
parents: 125
diff changeset
  1089
     when the button is pressed (if non-nil)"
claus
parents: 125
diff changeset
  1090
claus
parents: 125
diff changeset
  1091
    ^ controller pressAction
claus
parents: 125
diff changeset
  1092
!
claus
parents: 125
diff changeset
  1093
claus
parents: 125
diff changeset
  1094
pressAction:aBlock
claus
parents: 125
diff changeset
  1095
    "define the action to be performed on press"
claus
parents: 125
diff changeset
  1096
claus
parents: 125
diff changeset
  1097
    controller pressAction:aBlock
claus
parents: 125
diff changeset
  1098
!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1099
127
claus
parents: 125
diff changeset
  1100
releaseAction
claus
parents: 125
diff changeset
  1101
    "return the releaseAction; thats the block which gets evaluated
claus
parents: 125
diff changeset
  1102
     when the button is relreased (if non-nil)"
claus
parents: 125
diff changeset
  1103
claus
parents: 125
diff changeset
  1104
    ^ controller releaseAction
claus
parents: 125
diff changeset
  1105
!
claus
parents: 125
diff changeset
  1106
claus
parents: 125
diff changeset
  1107
releaseAction:aBlock
claus
parents: 125
diff changeset
  1108
    "define the action to be performed on release"
claus
parents: 125
diff changeset
  1109
claus
parents: 125
diff changeset
  1110
    controller releaseAction:aBlock
claus
parents: 125
diff changeset
  1111
!
claus
parents: 125
diff changeset
  1112
claus
parents: 125
diff changeset
  1113
action:aBlock
claus
parents: 125
diff changeset
  1114
    "convenient method: depending on the setting of controllers triggerOnDown flag,
claus
parents: 125
diff changeset
  1115
     either set the press-action and clear any release-action or
claus
parents: 125
diff changeset
  1116
     vice versa, set the release-action and clear the press-action."
claus
parents: 125
diff changeset
  1117
claus
parents: 125
diff changeset
  1118
    controller action:aBlock
claus
parents: 125
diff changeset
  1119
!
claus
parents: 125
diff changeset
  1120
claus
parents: 125
diff changeset
  1121
autoRepeat
claus
parents: 125
diff changeset
  1122
    "turn on autorepeat"
claus
parents: 125
diff changeset
  1123
claus
parents: 125
diff changeset
  1124
    controller autoRepeat
claus
parents: 125
diff changeset
  1125
!
118
claus
parents: 113
diff changeset
  1126
claus
parents: 113
diff changeset
  1127
disable
claus
parents: 113
diff changeset
  1128
    "disable the button"
claus
parents: 113
diff changeset
  1129
claus
parents: 113
diff changeset
  1130
    controller disable.
claus
parents: 113
diff changeset
  1131
!
claus
parents: 113
diff changeset
  1132
claus
parents: 113
diff changeset
  1133
enable
claus
parents: 113
diff changeset
  1134
    "enable the button"
claus
parents: 113
diff changeset
  1135
claus
parents: 113
diff changeset
  1136
    controller enable
127
claus
parents: 125
diff changeset
  1137
! !
claus
parents: 125
diff changeset
  1138
claus
parents: 125
diff changeset
  1139
!Button methodsFor:'changing state'!
118
claus
parents: 113
diff changeset
  1140
claus
parents: 113
diff changeset
  1141
turnOffWithoutRedraw
claus
parents: 113
diff changeset
  1142
    "turn the button off - no redraw"
claus
parents: 113
diff changeset
  1143
claus
parents: 113
diff changeset
  1144
    controller pressed:false.
claus
parents: 113
diff changeset
  1145
    controller active:false.
claus
parents: 113
diff changeset
  1146
claus
parents: 113
diff changeset
  1147
    "do not use super level:offLevel
claus
parents: 113
diff changeset
  1148
     - because that one does redraw the edges.
claus
parents: 113
diff changeset
  1149
     Sure, this is no good coding style"
claus
parents: 113
diff changeset
  1150
    level := offLevel.
claus
parents: 113
diff changeset
  1151
    margin := level abs
claus
parents: 113
diff changeset
  1152
!
claus
parents: 113
diff changeset
  1153
claus
parents: 113
diff changeset
  1154
turnOff
claus
parents: 113
diff changeset
  1155
    "turn the button off (if not already off)"
claus
parents: 113
diff changeset
  1156
claus
parents: 113
diff changeset
  1157
    controller pressed ifTrue:[
128
claus
parents: 127
diff changeset
  1158
	self level:offLevel.
118
claus
parents: 113
diff changeset
  1159
	self turnOffWithoutRedraw.
claus
parents: 113
diff changeset
  1160
	self redraw
claus
parents: 113
diff changeset
  1161
    ]
claus
parents: 113
diff changeset
  1162
!
claus
parents: 113
diff changeset
  1163
claus
parents: 113
diff changeset
  1164
turnOnWithoutRedraw
claus
parents: 113
diff changeset
  1165
    "turn the button on - no redraw"
claus
parents: 113
diff changeset
  1166
claus
parents: 113
diff changeset
  1167
    controller pressed:true.
claus
parents: 113
diff changeset
  1168
claus
parents: 113
diff changeset
  1169
    "do not use super level:offLevel
claus
parents: 113
diff changeset
  1170
     - because that one does redraw the edges.
claus
parents: 113
diff changeset
  1171
     Sure, this is no good coding style"
claus
parents: 113
diff changeset
  1172
    level := onLevel.
claus
parents: 113
diff changeset
  1173
    margin := level abs
claus
parents: 113
diff changeset
  1174
!
claus
parents: 113
diff changeset
  1175
claus
parents: 113
diff changeset
  1176
turnOn
claus
parents: 113
diff changeset
  1177
    "turn the button on (if not already on)"
claus
parents: 113
diff changeset
  1178
claus
parents: 113
diff changeset
  1179
    controller pressed ifFalse:[
128
claus
parents: 127
diff changeset
  1180
	self level:onLevel.
118
claus
parents: 113
diff changeset
  1181
	self turnOnWithoutRedraw.
claus
parents: 113
diff changeset
  1182
	self redraw
claus
parents: 113
diff changeset
  1183
    ]
claus
parents: 113
diff changeset
  1184
!
claus
parents: 113
diff changeset
  1185
claus
parents: 113
diff changeset
  1186
toggleNoAction
claus
parents: 113
diff changeset
  1187
    "toggle, but do NOT perform any action - can be used to change a toggle
claus
parents: 113
diff changeset
  1188
     under program control (i.e. turn one toggle off from another one)"
claus
parents: 113
diff changeset
  1189
claus
parents: 113
diff changeset
  1190
    controller toggleNoAction
claus
parents: 113
diff changeset
  1191
!
claus
parents: 113
diff changeset
  1192
claus
parents: 113
diff changeset
  1193
toggle
claus
parents: 113
diff changeset
  1194
    "toggle and perform the action"
claus
parents: 113
diff changeset
  1195
claus
parents: 113
diff changeset
  1196
    controller toggle
claus
parents: 113
diff changeset
  1197
! !
claus
parents: 113
diff changeset
  1198
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1199
!Button methodsFor:'queries'!
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1200
130
claus
parents: 128
diff changeset
  1201
preferredExtent
claus
parents: 128
diff changeset
  1202
    "return my preferred extent - this is the minimum size I would like to have"
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1203
131
claus
parents: 130
diff changeset
  1204
    |extraH extraV|
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1205
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1206
    logo notNil ifTrue:[
131
claus
parents: 130
diff changeset
  1207
"
claus
parents: 130
diff changeset
  1208
	extraH := extraV := (onLevel abs max:offLevel abs) + ViewSpacing * 2.
claus
parents: 130
diff changeset
  1209
"
claus
parents: 130
diff changeset
  1210
	extraH := extraV := (onLevel abs max:offLevel abs).
claus
parents: 130
diff changeset
  1211
	extraH := (extraH + hSpace * 2).
claus
parents: 130
diff changeset
  1212
	extraV := (extraV + vSpace * 2).
claus
parents: 130
diff changeset
  1213
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1214
	self is3D ifFalse:[
97
cbf495fe3b64 *** empty log message ***
claus
parents: 95
diff changeset
  1215
	    "add space for a frame around"
131
claus
parents: 130
diff changeset
  1216
	    extraH := extraH + 2. extraV := extraV + 2.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1217
	].
131
claus
parents: 130
diff changeset
  1218
	^ (labelWidth + extraH) @ (labelHeight + extraV)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1219
    ].
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1220
130
claus
parents: 128
diff changeset
  1221
    ^ super preferredExtent
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1222
! !
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1223
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1224
!Button methodsFor:'private'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1225
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1226
computeLabelOrigin
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1227
    "compute the origin of the text - if  I am a returnButton,
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1228
     shift it somwehat to the right (we have already allocated the
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1229
     real estate, since computeLabelSize returned some extra space
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1230
     before)."
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1231
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1232
    super computeLabelOrigin.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1233
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1234
	labelOriginX := labelOriginX + hSpace + hSpace.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1235
    ]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1236
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1237
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1238
computeLabelSize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1239
    "compute the extent needed to hold the label plus the return form"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1240
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1241
    super computeLabelSize.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1242
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1243
	labelWidth := labelWidth + (hSpace * 2) + shadowForm width.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1244
	labelHeight := labelHeight max: (shadowForm height + vSpace)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1245
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1246
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1247
131
claus
parents: 130
diff changeset
  1248
XXresize
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1249
    "resize myself to make logo fit into myself.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1250
     Redefined, since we add space for a frame around text when non-3D"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1251
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1252
    |extra|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1253
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1254
    logo isNil ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1255
	self computeLabelOrigin.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1256
	(relativeExtent isNil and:[extentRule isNil]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1257
	    extra := (onLevel abs max:offLevel abs) * 2.
130
claus
parents: 128
diff changeset
  1258
	    styleSheet is3D ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1259
"/                (logo isKindOf:Form) ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1260
		    "add space for a rectangle around"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1261
		    extra := extra + 2
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1262
"/                ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1263
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1264
	    self extent:(labelWidth + extra) @ (labelHeight + extra)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1265
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1266
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1267
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1268
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1269
!Button methodsFor:'redrawing'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1270
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1271
drawEdges
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1272
    "draw all of my 3D edges"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1273
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1274
    self drawEdgesForX:0 y:0 width:width height:height level:level 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1275
		shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1276
		light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1277
		halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1278
		halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1279
		style:edgeStyle 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1280
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1281
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1282
drawLeftEdge
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1283
    "draw left 3D edge into window frame"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1284
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1285
    self drawLeftEdgeLevel:level
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1286
		    shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1287
		     light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1288
		     halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1289
		     halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1290
		     style:edgeStyle.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1291
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1292
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1293
drawRightEdge
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1294
    "draw right 3D edge into window frame"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1295
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1296
    self drawRightEdgeLevel:level
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1297
		     shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1298
		      light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1299
		      halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1300
		      halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1301
		      style:edgeStyle.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1302
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1303
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1304
drawTopEdge
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1305
    "draw top 3D edge into window frame"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1306
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1307
    self drawTopEdgeLevel:level
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1308
		   shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1309
		   light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1310
		   halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1311
		   halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1312
		   style:edgeStyle.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1313
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1314
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1315
drawBottomEdge
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1316
    "draw bottom 3D edge into window frame"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1317
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1318
    self drawBottomEdgeLevel:level
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1319
		      shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1320
		      light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1321
		      halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1322
		      halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1323
		      style:edgeStyle.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1324
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1325
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1326
drawWith:fg and:bg
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1327
    "redraw myself with fg/bg. Use super to draw the label, add
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1328
     the return-arrow here."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1329
18
66bf62e27141 *** empty log message ***
claus
parents: 6
diff changeset
  1330
    |x y sColor lColor|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1331
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1332
    shown ifFalse:[^ self].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1333
    super drawWith:fg and:bg.   "this draws the text"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1334
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1335
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1336
	y := (height - shadowForm height) // 2.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1337
	x := width - shadowForm width - (hSpace // 2).
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1338
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1339
	formShadowColor isNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1340
	    self paint:fg on:bg.
130
claus
parents: 128
diff changeset
  1341
"/            self background:bg.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1342
	    self displayOpaqueForm:shadowForm x:x y:y.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1343
	    ^ self
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1344
	].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1345
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1346
	"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1347
	 drawing form in 3d-style (i.e. with shadow and light)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1348
	"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1349
	(formShadowColor isColor and:[formShadowColor colorId notNil
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1350
	 and:[formLightColor isColor and:[formLightColor colorId notNil
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1351
	 and:[formColor isColor and:[formColor colorId notNil]]]]])
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1352
	ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1353
	    sColor := formShadowColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1354
	    lColor := formLightColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1355
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1356
	    sColor := Black.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1357
	    lColor := White.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1358
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1359
	self foreground:sColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1360
	self displayForm:shadowForm x:x y:y.
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1361
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1362
	lightForm notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1363
	    self foreground:lColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1364
	    self displayForm:lightForm x:x y:y.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1365
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1366
	self paint:fg.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1367
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1368
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1369
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1370
showPassive
82
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1371
    "redraw myself as passive"
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1372
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1373
    offLevel ~~ level ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1374
	self level:offLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1375
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1376
    (passiveLogo notNil and:[passiveLogo ~~ logo]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1377
	self logo:passiveLogo
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1378
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1379
    self redraw.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1380
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1381
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1382
showActive
118
claus
parents: 113
diff changeset
  1383
    "redraw myself as active (i.e. busy)"
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1384
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1385
    onLevel ~~ level ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1386
	self level:onLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1387
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1388
    (activeLogo notNil and:[activeLogo ~~ logo]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1389
	self logo:activeLogo
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1390
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1391
    self redraw.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1392
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1393
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1394
redrawIfPressed
82
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1395
    "redraw the button, but only if visible and currently being pressed"
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1396
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1397
    shown ifTrue:[
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1398
	controller pressed ifTrue:[
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1399
	    self redraw
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1400
	]
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1401
    ]
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1402
!
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1403
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1404
redraw
82
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1405
    "redraw the button. 
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1406
     Thats like redrawing a label, but use different colors when pressed
6f2d05f1da80 *** empty log message ***
claus
parents: 77
diff changeset
  1407
     or entered."
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1408
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1409
    |fg bg entered|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1410
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1411
    shown ifFalse:[^ self].
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1412
    controller active ifTrue:[^ self].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1413
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1414
    fg := fgColor.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1415
    bg := bgColor.
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1416
    controller enabled ifFalse:[
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1417
	fg := disabledFgColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1418
    ] ifTrue:[
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1419
	entered := controller entered.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1420
	entered ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1421
	    enteredFgColor notNil ifTrue:[fg := enteredFgColor].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1422
	    enteredBgColor notNil ifTrue:[bg := enteredBgColor]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1423
	].
77
565b052f5277 *** empty log message ***
claus
parents: 74
diff changeset
  1424
	(controller pressed and:[entered or:[controller isTriggerOnDown]]) ifTrue:[
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1425
	    activeFgColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1426
		onLevel == offLevel ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1427
		    fg := bgColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1428
		]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1429
	    ] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1430
		fg := activeFgColor.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1431
	    ].
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1432
	    activeBgColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1433
		onLevel == offLevel ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1434
		    bg := fgColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1435
		]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1436
	    ] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1437
		bg := activeBgColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1438
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1439
	    self is3D ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1440
		self drawWith:fg and:bg .
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1441
		"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1442
		 draw a rectangle around
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1443
		"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1444
		self paint:fg.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1445
		self displayRectangleX:0 y:0 width:width height:height.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1446
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1447
		^ self
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1448
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1449
	].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1450
    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1451
    self drawWith:fg and:bg
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1452
! !