ScrollBar.st
author ca
Fri, 09 Feb 1996 13:48:15 +0100
changeset 338 9cbc51998a23
parent 205 6814c0bf8df8
child 345 00abc00e73a9
permissions -rw-r--r--
oops
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     1
"
5
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
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
119
claus
parents: 110
diff changeset
    13
SimpleView subclass:#ScrollBar
130
claus
parents: 128
diff changeset
    14
	 instanceVariableNames:'thumb button1 button2 buttonLayout elementSpacing'
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
    15
	 classVariableNames:'DefaultButtonPositions DefaultLevel DefaultElementSpacing
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    16
                DefaultScrollerBordered'
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
    17
	 poolDictionaries:''
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
    18
	 category:'Views-Interactors'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    19
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    20
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    21
!ScrollBar class methodsFor:'documentation'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    22
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    23
copyright
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    24
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    25
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    26
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    27
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    28
 This software is furnished under a license and may be used
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    29
 only in accordance with the terms of that license and with the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    31
 be provided or otherwise made available to, or used by, any
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    32
 other person.  No title to or ownership of the software is
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    33
 hereby transferred.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    34
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    35
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    36
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    37
documentation
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    38
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    39
    this class implements vertical scrollbars with scroller and
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    40
    2 step-scroll buttons. when moved or stepped, it performs a
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    41
    predefined action.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    42
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    43
    The action is specified by:                 the block to be evaluated for step-up
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    44
	aScrollBar scrollUpAction:aBlock 
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    45
	(scrollLeftAction for hor-Scrollbars)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    46
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    47
	aScrollBar scrollDownAction:aBlock      the block to be evaluated for step-down
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    48
	(scrollRightAction for hor-Scrollbars)
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    49
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    50
	aScrollbar scrollAction:aBlock          the block to be evaluated for scroll
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    51
						passing percentage as argument.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    52
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    53
    Scrollbars can scroll syncronous (i.e. every movement is notified immediately via the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    54
    scrollAction) or asynchronous (i.e. only one notification takes place at the end of the movement).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    55
    The choice is up to the user of the scrollbar (typically, views which are complicated to redraw,
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    56
    will set it to asynchronous.)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    57
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    58
    Most often scrollbars are used hidden with ScrollableView or HVScrollableView (i.e. you
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    59
    dont have to care for all the details).
128
claus
parents: 119
diff changeset
    60
claus
parents: 119
diff changeset
    61
    The scrollBars and scrollers protocols have been made similar enough to
claus
parents: 119
diff changeset
    62
    allow transparent use of either a scroller or a scrollBar in applications.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    63
"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    64
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    65
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    66
!ScrollBar class methodsFor:'style changes'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    67
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    68
updateStyleCache
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    69
    DefaultButtonPositions := StyleSheet at:'scrollBarButtonPositions' default:#bottom.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    70
    DefaultLevel := StyleSheet at:'scrollBarLevel'.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    71
    DefaultScrollerBordered := StyleSheet at:'scrollBarScrollerBordered' default:false.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    72
    DefaultElementSpacing := StyleSheet at:'scrollBarElementSpacing' 
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    73
					default:(StyleSheet is3D ifTrue:[1] ifFalse:[0]).
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    74
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    75
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    76
!ScrollBar methodsFor:'accessing'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    77
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    78
downButton
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    79
    "return the down-button
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    80
     (Please: only use direct access for special applications)"
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    81
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    82
    ^ button2
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    83
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    84
    "
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    85
     |v|
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    86
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    87
     v := ScrollableView for:EditTextView.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    88
     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    89
     v scrollBar upButton activeForegroundColor:Color red.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    90
     v scrollBar downButton activeForegroundColor:Color red.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    91
     v open
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    92
    "
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
    93
!
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
    94
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    95
setThumbFor:aView
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    96
    "adjust thumb for aView 
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    97
     (i.e. adjust thumbs origin & size for views size & views contents).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
    98
     This is forwarded to the scroller here."
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    99
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   100
    thumb setThumbFor:aView.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   101
    self enableDisableButtons
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   102
!
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   103
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   104
setThumbHeightFor:aView
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   105
    "adjust thumbs height for aViews size & contents.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   106
     This is forwarded to the scroller here."
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   107
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   108
    thumb setThumbHeightFor:aView.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   109
    self enableDisableButtons
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   110
!
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   111
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   112
setThumbOriginFor:aView
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   113
    "adjust thumbs origin for aViews size & contents.
128
claus
parents: 119
diff changeset
   114
     This is forwarded to the scroller here."
claus
parents: 119
diff changeset
   115
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   116
    thumb setThumbOriginFor:aView.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   117
    self enableDisableButtons
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   118
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   119
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   120
thumbColor:aColor
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   121
    "set the thumbs color"
128
claus
parents: 119
diff changeset
   122
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   123
    thumb thumbColor:aColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   124
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   125
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   126
thumbHeight
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   127
    "return height of thumb in percent"
128
claus
parents: 119
diff changeset
   128
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   129
    ^ thumb thumbHeight
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   130
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   131
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   132
thumbHeight:newHeight
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   133
    "set height of thumb in percent"
128
claus
parents: 119
diff changeset
   134
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   135
    thumb thumbHeight:newHeight.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   136
    self enableDisableButtons
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   137
!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   138
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   139
thumbOrigin
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   140
    "return position of (top of) thumb in percent"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   141
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   142
    ^ thumb thumbOrigin
128
claus
parents: 119
diff changeset
   143
!
claus
parents: 119
diff changeset
   144
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   145
thumbOrigin:newOrigin
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   146
    "set position of (top of) thumb in percent"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   147
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   148
    thumb thumbOrigin:newOrigin.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   149
    self enableDisableButtons
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   150
!
128
claus
parents: 119
diff changeset
   151
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   152
thumbOrigin:newOrigin thumbHeight:newHeight
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   153
    "set origin and height of thumb (both in percent)"
128
claus
parents: 119
diff changeset
   154
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   155
    thumb thumbOrigin:newOrigin thumbHeight:newHeight.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   156
    self enableDisableButtons
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   157
!
128
claus
parents: 119
diff changeset
   158
133
claus
parents: 130
diff changeset
   159
upButton
claus
parents: 130
diff changeset
   160
    "return the up-button
claus
parents: 130
diff changeset
   161
     (Please: only use direct access for special applications)"
claus
parents: 130
diff changeset
   162
claus
parents: 130
diff changeset
   163
    ^ button1
claus
parents: 130
diff changeset
   164
claus
parents: 130
diff changeset
   165
    "
claus
parents: 130
diff changeset
   166
     |v|
claus
parents: 130
diff changeset
   167
claus
parents: 130
diff changeset
   168
     v := ScrollableView for:EditTextView.
claus
parents: 130
diff changeset
   169
     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).
claus
parents: 130
diff changeset
   170
     v scrollBar upButton foregroundColor:(Color red).
claus
parents: 130
diff changeset
   171
     v scrollBar upButton enteredForegroundColor:(Color red lightened).
claus
parents: 130
diff changeset
   172
     v scrollBar downButton foregroundColor:(Color green).
claus
parents: 130
diff changeset
   173
     v scrollBar downButton enteredForegroundColor:(Color green lightened).
claus
parents: 130
diff changeset
   174
     v open
claus
parents: 130
diff changeset
   175
    "
claus
parents: 130
diff changeset
   176
!
claus
parents: 130
diff changeset
   177
claus
parents: 130
diff changeset
   178
upButtonLabel:label1 downButtonLabel:label2
claus
parents: 130
diff changeset
   179
    "set the labels shown in the buttons"
claus
parents: 130
diff changeset
   180
claus
parents: 130
diff changeset
   181
    button1 label:label1.
claus
parents: 130
diff changeset
   182
    button2 label:label2.
claus
parents: 130
diff changeset
   183
    self setElementPositions.
claus
parents: 130
diff changeset
   184
claus
parents: 130
diff changeset
   185
    "
claus
parents: 130
diff changeset
   186
     |v|
claus
parents: 130
diff changeset
   187
claus
parents: 130
diff changeset
   188
     v := ScrollableView for:EditTextView.
claus
parents: 130
diff changeset
   189
     v scrolledView contents:('/etc/passwd' asFilename contentsOfEntireFile).
claus
parents: 130
diff changeset
   190
     v scrollBar upButtonLabel:'+' downButtonLabel:'-'.
claus
parents: 130
diff changeset
   191
     v open
claus
parents: 130
diff changeset
   192
    "
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   193
! !
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   194
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   195
!ScrollBar methodsFor:'accessing-behavior'!
133
claus
parents: 130
diff changeset
   196
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   197
asynchronousOperation
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   198
    "set asynchronous-mode - scroll action is performed after movement
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   199
     of scroller (i.e. when mouse-button is finally released).
128
claus
parents: 119
diff changeset
   200
     This is forwarded to the scroller here."
claus
parents: 119
diff changeset
   201
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   202
    thumb asynchronousOperation
128
claus
parents: 119
diff changeset
   203
!
claus
parents: 119
diff changeset
   204
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   205
scrollAction:aBlock
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   206
    "set the action, aBlock to be performed when the scroller is moved.
128
claus
parents: 119
diff changeset
   207
     This is forwarded to the scroller here."
claus
parents: 119
diff changeset
   208
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   209
    thumb scrollAction:aBlock
128
claus
parents: 119
diff changeset
   210
!
claus
parents: 119
diff changeset
   211
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   212
scrollDownAction:aBlock
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   213
    "set the action, aBlock to be performed when the down-button is pressed."
128
claus
parents: 119
diff changeset
   214
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   215
    button2 action:aBlock
128
claus
parents: 119
diff changeset
   216
!
claus
parents: 119
diff changeset
   217
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   218
scrollUpAction:aBlock
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   219
    "set the action, aBlock to be performed when the up-button is pressed."
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
   220
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   221
    button1 action:aBlock
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   222
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   223
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   224
synchronousOperation
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   225
    "set synchronous-mode - scroll action is performed for every movement
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   226
     of scroller.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   227
     This is forwarded to the scroller here."
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   228
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   229
    thumb synchronousOperation
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   230
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   231
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   232
!ScrollBar methodsFor:'change & update'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   233
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   234
update:something with:aParameter from:changedObject
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   235
    changedObject == thumb ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   236
	self enableDisableButtons
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   237
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   238
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   239
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   240
!ScrollBar methodsFor:'events'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   241
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   242
sizeChanged:how
128
claus
parents: 119
diff changeset
   243
    "when my size changes, I have to resize/reposition the subviews.
claus
parents: 119
diff changeset
   244
     Also, if I became too small, hide thumb/buttons."
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   245
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   246
    |upHeight downHeight thumbHeight upAndDownHeight bwn sep2
130
claus
parents: 128
diff changeset
   247
     thumbWidth w style b1Hidden b2Hidden thumbHidden bY|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   248
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   249
    button1 isNil ifTrue:[^ self].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   250
    thumb isNil ifTrue:[^ self].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   251
    button2 isNil ifTrue:[^ self].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   252
130
claus
parents: 128
diff changeset
   253
    style := styleSheet name.
128
claus
parents: 119
diff changeset
   254
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   255
    upHeight := button1 height + borderWidth.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   256
    downHeight := button2 height + borderWidth.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   257
    upAndDownHeight := upHeight + downHeight.
3
claus
parents: 0
diff changeset
   258
    bwn := borderWidth negated + margin.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   259
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   260
    thumbHeight := height - upAndDownHeight - borderWidth - (elementSpacing * 3).
3
claus
parents: 0
diff changeset
   261
"
130
claus
parents: 128
diff changeset
   262
    ((buttonLayout ~~ #top) and:[buttonLayout ~~ #bottom]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   263
	thumbHeight := thumbHeight - borderWidth
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   264
    ].
3
claus
parents: 0
diff changeset
   265
"
130
claus
parents: 128
diff changeset
   266
    buttonLayout == #around ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   267
	thumbHeight := thumbHeight + borderWidth
3
claus
parents: 0
diff changeset
   268
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   269
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   270
    "if I become too small, hide buttons and thumb"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   271
130
claus
parents: 128
diff changeset
   272
    height < upAndDownHeight ifTrue:[
claus
parents: 128
diff changeset
   273
	b1Hidden := b2Hidden := thumbHidden := true.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   274
    ] ifFalse:[
130
claus
parents: 128
diff changeset
   275
	b1Hidden := b2Hidden := thumbHidden := false.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   276
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   277
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   278
    (thumbHeight < 10) ifTrue:[
130
claus
parents: 128
diff changeset
   279
	thumbHidden := true.
claus
parents: 128
diff changeset
   280
    ] ifFalse:[
claus
parents: 128
diff changeset
   281
	thumbHidden := false.
claus
parents: 128
diff changeset
   282
    ].
claus
parents: 128
diff changeset
   283
claus
parents: 128
diff changeset
   284
    button1 hiddenOnRealize:b1Hidden.
claus
parents: 128
diff changeset
   285
    b1Hidden ifTrue:[
claus
parents: 128
diff changeset
   286
	button1 unrealize
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   287
    ] ifFalse:[
130
claus
parents: 128
diff changeset
   288
	shown ifTrue:[button1 realize]
claus
parents: 128
diff changeset
   289
    ].
claus
parents: 128
diff changeset
   290
    button2 hiddenOnRealize:b1Hidden.
claus
parents: 128
diff changeset
   291
    b2Hidden ifTrue:[
claus
parents: 128
diff changeset
   292
	button2 unrealize
claus
parents: 128
diff changeset
   293
    ] ifFalse:[
claus
parents: 128
diff changeset
   294
	shown ifTrue:[button2 realize]
claus
parents: 128
diff changeset
   295
    ].
claus
parents: 128
diff changeset
   296
    thumb hiddenOnRealize:thumbHidden.
claus
parents: 128
diff changeset
   297
    thumbHidden ifTrue:[
claus
parents: 128
diff changeset
   298
	thumb unrealize
claus
parents: 128
diff changeset
   299
    ] ifFalse:[
claus
parents: 128
diff changeset
   300
	shown ifTrue:[thumb realize]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   301
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   302
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   303
    "width of buttons is always my width"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   304
3
claus
parents: 0
diff changeset
   305
    w := width - (margin * 2).
claus
parents: 0
diff changeset
   306
    (w ~~ button1 width) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   307
	button1 width:w.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   308
	button2 width:w
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   309
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   310
3
claus
parents: 0
diff changeset
   311
    thumbWidth := w.
128
claus
parents: 119
diff changeset
   312
    style == #next ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   313
	thumbWidth := thumbWidth - (thumb borderWidth * 2).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   314
	thumbHeight := thumbHeight - 1
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   315
    ].
128
claus
parents: 119
diff changeset
   316
    style == #motif ifTrue:[
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   317
	thumbHeight := thumbHeight - margin
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   318
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   319
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   320
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   321
     a kludge: views with width or height of 0 are illegal
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   322
     avoid error from view-creation (it will be hidden anyway)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   323
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   324
    thumbHeight <= 0 ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   325
	thumbHeight := 1
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   326
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   327
130
claus
parents: 128
diff changeset
   328
    (buttonLayout == #top) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   329
	"buttons at top"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   330
	thumb extent:(thumbWidth @ thumbHeight).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   331
	^ self
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   332
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   333
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   334
    sep2 := elementSpacing * 2.
130
claus
parents: 128
diff changeset
   335
    (buttonLayout == #bottom) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   336
	"buttons at bottom"
143
claus
parents: 140
diff changeset
   337
"/
claus
parents: 140
diff changeset
   338
"/ XX: I thought, that viewGravity shuld fix things automatically
claus
parents: 140
diff changeset
   339
"/ XX: it seems not to do it (or I misused it ;-)
claus
parents: 140
diff changeset
   340
"/ XX: anyway, viewGravity is an X special feature which is probably
claus
parents: 140
diff changeset
   341
"/ XX: not available with other windowing systems. Therefore,
claus
parents: 140
diff changeset
   342
"/ XX: the viewGravity depending code below is disabled.
claus
parents: 140
diff changeset
   343
"/ XX: resize is somewhat slower, though.
claus
parents: 140
diff changeset
   344
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   345
	thumbHeight := thumbHeight + borderWidth.
143
claus
parents: 140
diff changeset
   346
"/ XX        thumbHidden ifTrue:[
claus
parents: 140
diff changeset
   347
"/ XX           bY := elementSpacing
claus
parents: 140
diff changeset
   348
"/ XX       ] ifFalse:[
130
claus
parents: 128
diff changeset
   349
	    bY := thumbHeight + sep2.
143
claus
parents: 140
diff changeset
   350
"/ XX       ].
claus
parents: 140
diff changeset
   351
"XX"            button1 viewGravity:#North. 
claus
parents: 140
diff changeset
   352
"XX"            button2 viewGravity:#North. 
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   353
	(how == #smaller) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   354
	    thumb extent:(thumbWidth @ thumbHeight).
143
claus
parents: 140
diff changeset
   355
"XX"            button1 origin:(bwn @ (thumbHeight + sep2)).
claus
parents: 140
diff changeset
   356
"XX"            button2 origin:(bwn @ (thumbHeight + sep2 + upHeight))
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   357
	] ifFalse:[
130
claus
parents: 128
diff changeset
   358
	    button1 origin:(bwn @ bY).
claus
parents: 128
diff changeset
   359
	    button2 origin:(bwn @ (bY + upHeight)).
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   360
	    thumb extent:(thumbWidth @ thumbHeight)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   361
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   362
	^ self
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   363
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   364
    "buttons around thumb"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   365
128
claus
parents: 119
diff changeset
   366
    style == #motif ifTrue:[
claus
parents: 119
diff changeset
   367
	sep2 := sep2 + 1
claus
parents: 119
diff changeset
   368
    ].
3
claus
parents: 0
diff changeset
   369
    button1 origin:(bwn @ bwn).
128
claus
parents: 119
diff changeset
   370
claus
parents: 119
diff changeset
   371
    style == #os2 ifTrue:[
claus
parents: 119
diff changeset
   372
	button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - margin "+ borderWidth")).
claus
parents: 119
diff changeset
   373
	thumb extent:(thumbWidth @ (thumbHeight - margin - margin "+ margin - (margin // 2)")).
claus
parents: 119
diff changeset
   374
	thumb origin:(bwn @ (upHeight - borderWidth + elementSpacing + margin))
claus
parents: 119
diff changeset
   375
    ] ifFalse:[
claus
parents: 119
diff changeset
   376
	button2 origin:(bwn @ (upHeight + thumbHeight + sep2 - (margin // 2) "+ borderWidth")).
claus
parents: 119
diff changeset
   377
	thumb extent:(thumbWidth @ (thumbHeight + margin - (margin // 2))).
claus
parents: 119
diff changeset
   378
	thumb origin:(bwn @ (upHeight - borderWidth + elementSpacing))
claus
parents: 119
diff changeset
   379
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   380
! !
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   381
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   382
!ScrollBar methodsFor:'forced scroll'!
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   383
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   384
pageDown
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   385
    "page down/right"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   386
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   387
    thumb pageDown
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   388
!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   389
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   390
pageUp
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   391
    "page up/left"
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   392
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   393
    thumb pageUp
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   394
! !
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   395
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   396
!ScrollBar methodsFor:'initialization'!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   397
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   398
computeInitialExtent
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   399
    "compute my extent from sub-components"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   400
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   401
    self extent:(self preferredExtent).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   402
!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   403
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   404
createElements
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   405
    button1 := ArrowButton upIn:self.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   406
    button2 := ArrowButton downIn:self.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   407
    thumb := Scroller in:self.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   408
!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   409
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   410
initStyle
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   411
    super initStyle.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   412
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   413
    buttonLayout := DefaultButtonPositions.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   414
    DefaultLevel notNil ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   415
	self level:DefaultLevel
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   416
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   417
    elementSpacing := DefaultElementSpacing
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   418
!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   419
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   420
initialize
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   421
    "setup; create the 2 buttons and a scroller"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   422
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   423
    |clr style|
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   424
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   425
    super initialize.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   426
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   427
    self createElements.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   428
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   429
    (styleSheet at:'scrollBarDisableButtons' default:false) ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   430
	thumb addDependent:self
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   431
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   432
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   433
    button1 autoRepeat.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   434
    button2 autoRepeat.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   435
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   436
    self computeInitialExtent.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   437
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   438
    button1 borderWidth:borderWidth.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   439
    DefaultScrollerBordered ifFalse:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   440
	thumb borderWidth:borderWidth.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   441
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   442
    button2 borderWidth:borderWidth.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   443
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   444
    style := styleSheet name.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   445
    ((style = #iris) and:[Display hasGreyscales]) ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   446
	"have to change some of Buttons defaults"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   447
	clr := (Color grey:25) on:device.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   448
	button1 offLevel:2.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   449
	button2 offLevel:2.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   450
	button1 foregroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   451
	button1 activeForegroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   452
	button1 enteredForegroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   453
	button2 foregroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   454
	button2 activeForegroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   455
	button2 enteredForegroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   456
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   457
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   458
    self setElementPositions.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   459
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   460
    style = #motif ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   461
	clr := thumb thumbColor.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   462
	button1 foregroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   463
	button2 foregroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   464
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   465
	clr := thumb viewBackground.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   466
	button1 viewBackground:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   467
	button2 viewBackground:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   468
	button1 backgroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   469
	button2 backgroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   470
	button1 activeBackgroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   471
	button2 activeBackgroundColor:clr.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   472
	device hasGreyscales ifFalse:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   473
	    button1 activeForegroundColor:Black.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   474
	    button2 activeForegroundColor:Black.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   475
	]
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   476
    ]
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   477
!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   478
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   479
reinitialize
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   480
    super reinitialize.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   481
    self setElementPositions.
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   482
!
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   483
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   484
setElementPositions
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   485
    "position sub-components"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   486
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   487
    |bwn|
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   488
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   489
    bwn := borderWidth negated + margin.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   490
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   491
    (buttonLayout == #top) ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   492
	button1 origin:(bwn @ bwn).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   493
	button1 viewGravity:#North.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   494
	button2 origin:(bwn @ (button1 height)).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   495
	button2 viewGravity:#North.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   496
	thumb origin:(bwn @ (button1 height 
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   497
			     + borderWidth 
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   498
			     + button2 height 
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   499
			     + elementSpacing 
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   500
			     + elementSpacing)).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   501
	thumb viewGravity:#North.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   502
	^ self
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   503
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   504
    (buttonLayout == #bottom) ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   505
	device supportsViewGravity ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   506
	    button1 viewGravity:#South. 
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   507
	    button2 viewGravity:#South. 
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   508
	    thumb viewGravity:#North.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   509
	].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   510
	thumb origin:(bwn @ bwn).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   511
	^ self
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   512
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   513
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   514
    "buttonLayout == #around"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   515
    button1 origin:(bwn @ bwn).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   516
    button1 viewGravity:#North.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   517
"/    button2 viewGravity:#North.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   518
    thumb origin:(bwn @ (button1 height + elementSpacing)).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   519
    thumb viewGravity:#North
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   520
! !
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   521
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   522
!ScrollBar methodsFor:'private'!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   523
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   524
enableDisableButtons
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   525
    "only used with styles which disable their buttons if the
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   526
     thumb is at either end. Check where the thumb is and enable/disable
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   527
     as appropriate."
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   528
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   529
    |e1 e2 th to|
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   530
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   531
    (styleSheet at:'scrollBarDisableButtons' default:false) ifFalse:[^ self].
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   532
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   533
    e1 := e2 := true.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   534
    (th := thumb thumbHeight) notNil ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   535
	(th >= (thumb stop)) ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   536
	    e1 := false.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   537
	    e2 := false
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   538
	]
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   539
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   540
    ((to := thumb thumbOrigin) <= thumb start) ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   541
	e1 := false
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   542
    ] ifFalse:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   543
	th isNil ifTrue:[th := 0].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   544
	(to + th) >= thumb stop ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   545
	    e2 := false
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   546
	]
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   547
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   548
    e1 ifTrue:[button1 enable] ifFalse:[button1 disable].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   549
    e2 ifTrue:[button2 enable] ifFalse:[button2 disable].
110
eb59f6e31e84 *** empty log message ***
claus
parents: 77
diff changeset
   550
! !
205
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   551
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   552
!ScrollBar methodsFor:'queries'!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   553
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   554
preferredExtent
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   555
    "compute my extent from sub-components"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   556
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   557
    |w h upForm downForm
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   558
     upHeight   "{ Class: SmallInteger }"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   559
     downHeight "{ Class: SmallInteger }"
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   560
     upWidth downWidth style|
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   561
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   562
    "
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   563
     need fix - this is a kludge;
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   564
     the if should not be needed ...
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   565
    "
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   566
    style := styleSheet name.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   567
    style == #mswindows ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   568
	w := button1 width max:button2 width.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   569
	h := button1 height + button2 height + (Scroller defaultExtent y).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   570
    ] ifFalse:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   571
	upForm  := ArrowButton upArrowButtonForm:style on:device.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   572
	downForm := ArrowButton downArrowButtonForm:style on:device.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   573
	upForm isNil ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   574
	    upHeight := upWidth := 16.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   575
	] ifFalse:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   576
	    upHeight := upForm height.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   577
	    upWidth := upForm width
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   578
	].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   579
	downForm isNil ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   580
	    downHeight := downWidth := 16
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   581
	] ifFalse:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   582
	    downHeight := downForm height.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   583
	    downWidth := downForm width
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   584
	].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   585
	h := upHeight + downHeight + (1 * 2) + (Scroller defaultExtent y).
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   586
	w := upWidth max:downWidth.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   587
	style ~~ #normal ifTrue:[
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   588
	    h := h + 4.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   589
	    w := w + 4
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   590
	].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   591
    ].
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   592
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   593
    ^ w @ h.
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   594
! !
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   595
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   596
!ScrollBar class methodsFor:'documentation'!
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   597
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   598
version
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   599
    ^ '$Header: /cvs/stx/stx/libwidg/ScrollBar.st,v 1.20 1995-11-23 18:18:24 cg Exp $'
6814c0bf8df8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 174
diff changeset
   600
! !