Slider.st
author Claus Gittinger <cg@exept.de>
Tue, 30 Apr 1996 17:37:30 +0200
changeset 165 b758808c4ab8
parent 159 0596de11a136
child 184 13a2f3677c68
permissions -rw-r--r--
checkin from browser
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
     1
"
4
claus
parents: 2
diff changeset
     2
 COPYRIGHT (c) 1992 by Claus Gittinger
24
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
     3
	      All Rights Reserved
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
     4
0fd7841626f6 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
0fd7841626f6 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
0fd7841626f6 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
0fd7841626f6 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
0fd7841626f6 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
0fd7841626f6 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
0fd7841626f6 Initial revision
claus
parents:
diff changeset
    11
"
0fd7841626f6 Initial revision
claus
parents:
diff changeset
    12
0fd7841626f6 Initial revision
claus
parents:
diff changeset
    13
Scroller subclass:#Slider
137
e4c9a7cc26d0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    14
	instanceVariableNames:'sliderHeight'
e4c9a7cc26d0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    15
	classVariableNames:''
e4c9a7cc26d0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    16
	poolDictionaries:''
e4c9a7cc26d0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
    17
	category:'Views-Interactors'
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
    18
!
0fd7841626f6 Initial revision
claus
parents:
diff changeset
    19
11
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    20
!Slider class methodsFor:'documentation'!
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    21
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    22
copyright
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    23
"
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    24
 COPYRIGHT (c) 1992 by Claus Gittinger
24
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
    25
	      All Rights Reserved
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
    26
11
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    27
 This software is furnished under a license and may be used
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    28
 only in accordance with the terms of that license and with the
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    30
 be provided or otherwise made available to, or used by, any
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    31
 other person.  No title to or ownership of the software is
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    32
 hereby transferred.
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    33
"
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    34
!
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
    35
11
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    36
documentation
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    37
"
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    38
    this class implements sliders - which are simply scrollers
49
claus
parents: 48
diff changeset
    39
    with a constant thumbHeight. For details on actionBlocks and
claus
parents: 48
diff changeset
    40
    MVC operation, see the documentation in Scroller.
155
bc94dad4ad31 documentation
Claus Gittinger <cg@exept.de>
parents: 137
diff changeset
    41
bc94dad4ad31 documentation
Claus Gittinger <cg@exept.de>
parents: 137
diff changeset
    42
    [author:]
bc94dad4ad31 documentation
Claus Gittinger <cg@exept.de>
parents: 137
diff changeset
    43
        Claus Gittinger
11
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
    44
"
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    45
!
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    46
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    47
examples
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    48
"
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    49
    a slider with action block (ST/X style):
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    50
                                                                        [exBegin]
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    51
        |top s|
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    52
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    53
        top := StandardSystemView new extent:200@200.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    54
        s := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    55
        s origin:(0.0@0.0) corner:(20@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    56
        s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    57
        top open
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    58
                                                                        [exEnd]
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    59
49
claus
parents: 48
diff changeset
    60
    same, horizontal:
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    61
                                                                        [exBegin]
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    62
        |top s|
49
claus
parents: 48
diff changeset
    63
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    64
        top := StandardSystemView new extent:200@200.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    65
        s := HorizontalSlider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    66
        s origin:(0.0@0.0) corner:(1.0@20).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    67
        s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    68
        top open
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    69
                                                                        [exEnd]
49
claus
parents: 48
diff changeset
    70
claus
parents: 48
diff changeset
    71
    with a range other than the default:
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    72
                                                                        [exBegin]
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    73
        |top s|
49
claus
parents: 48
diff changeset
    74
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    75
        top := StandardSystemView new extent:200@200.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    76
        s := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    77
        s origin:(0.0@0.0) corner:(20@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    78
        s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    79
        s start:-50 stop:50.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    80
        top open
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    81
                                                                        [exEnd]
49
claus
parents: 48
diff changeset
    82
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    83
    using a model (ST-80 style):
49
claus
parents: 48
diff changeset
    84
    (see the changing value in the inspector)
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    85
                                                                        [exBegin]
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    86
        |top s m|
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    87
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    88
        m := 0 asValue.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    89
        m inspect.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    90
        top := StandardSystemView new extent:200@200.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    91
        s := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    92
        s origin:(0.0@0.0) corner:(20@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    93
        s model:m.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    94
        top open
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    95
                                                                        [exEnd]
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    96
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
    97
    reacting to changes from the model:
49
claus
parents: 48
diff changeset
    98
    (look at and/or change value using 'self value:' in the inspector).
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
    99
                                                                        [exBegin]
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   100
        |top s m|
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
   101
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   102
        m := 0 asValue.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   103
        m inspect. 
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   104
        top := StandardSystemView new extent:200@200.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   105
        s := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   106
        s origin:(0.0@0.0) corner:(20@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   107
        s model:m.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   108
        top open
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   109
                                                                        [exEnd]
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
   110
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
   111
    using a different changeSelector:
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   112
                                                                        [exBegin]
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   113
        |top s1 s2 m|
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
   114
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   115
        m := Plug new.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   116
        m respondTo:#value1: with:[:v | Transcript show:'scroller 1 moved to: '; showCr:v].
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   117
        m respondTo:#value2: with:[:v | Transcript show:'scroller 2 moved to: '; showCr:v].
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
   118
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   119
        top := StandardSystemView new extent:200@200.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   120
        s1 := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   121
        s1 origin:(0.0@0.0) corner:(20@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   122
        s1 thumbHeight:10.  'percent'.     
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   123
        s1 model:m; change:#value1:.
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
   124
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   125
        s2 := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   126
        s2 origin:(30@0.0) corner:(50@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   127
        s2 thumbHeight:10.  'percent'.     
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   128
        s2 model:m; change:#value2:.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   129
        top open
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   130
                                                                        [exEnd]
62
claus
parents: 49
diff changeset
   131
claus
parents: 49
diff changeset
   132
    another example:
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   133
                                                                        [exBegin]
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   134
        |top redVal greenVal blueVal 
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   135
         colorVal upd s1 s2 s3 l|
62
claus
parents: 49
diff changeset
   136
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   137
        redVal := 0 asValue.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   138
        greenVal := 0 asValue.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   139
        blueVal := 0 asValue.
62
claus
parents: 49
diff changeset
   140
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   141
        upd := [colorVal value:(Color red:redVal value
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   142
                                      green:greenVal value
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   143
                                      blue:blueVal value)].
62
claus
parents: 49
diff changeset
   144
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   145
        colorVal := (Color red:0 green:0 blue:0) asValue.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   146
        colorVal onChangeSend:#value to:[l backgroundColor:colorVal value].
62
claus
parents: 49
diff changeset
   147
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   148
        redVal onChangeSend:#value to:upd.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   149
        greenVal onChangeSend:#value to:upd.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   150
        blueVal onChangeSend:#value to:upd.
62
claus
parents: 49
diff changeset
   151
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   152
        top := StandardSystemView new extent:200@200.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   153
        top label:'Color mixer'.
62
claus
parents: 49
diff changeset
   154
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   155
        s1 := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   156
        s1 origin:(0.0@0.0) corner:(20@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   157
        s1 thumbHeight:10.  'percent'.     
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   158
        s1 model:redVal.
62
claus
parents: 49
diff changeset
   159
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   160
        s2 := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   161
        s2 origin:(30@0.0) corner:(50@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   162
        s2 thumbHeight:10.  'percent'.     
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   163
        s2 model:greenVal.
62
claus
parents: 49
diff changeset
   164
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   165
        s3 := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   166
        s3 origin:(60@0.0) corner:(80@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   167
        s3 thumbHeight:10.  'percent'.     
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   168
        s3 model:blueVal.
62
claus
parents: 49
diff changeset
   169
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   170
        l := Label in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   171
        l origin:90@0.0 corner:1.0@1.0.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   172
        l backgroundColor:Color black.
62
claus
parents: 49
diff changeset
   173
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   174
        top open
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   175
                                                                        [exEnd]
62
claus
parents: 49
diff changeset
   176
claus
parents: 49
diff changeset
   177
    the same setup, using action blocks:
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   178
                                                                        [exBegin]
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   179
        |top red green blue
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   180
         colorVal upd s1 s2 s3 labelModel l|
62
claus
parents: 49
diff changeset
   181
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   182
        red := green := blue := 0.
62
claus
parents: 49
diff changeset
   183
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   184
        top := StandardSystemView new extent:200@200.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   185
        top label:'Color mixer'.
62
claus
parents: 49
diff changeset
   186
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   187
        s1 := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   188
        s1 origin:(0.0@0.0) corner:(20@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   189
        s1 thumbHeight:10.  'percent'.     
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   190
        s1 action:[:percent | red := percent.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   191
                              l backgroundColor:(Color red:red green:green blue:blue)].
62
claus
parents: 49
diff changeset
   192
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   193
        s2 := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   194
        s2 origin:(30@0.0) corner:(50@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   195
        s2 thumbHeight:10.  'percent'.     
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   196
        s2 action:[:percent | green := percent.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   197
                              l backgroundColor:(Color red:red green:green blue:blue)].
62
claus
parents: 49
diff changeset
   198
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   199
        s3 := Slider in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   200
        s3 origin:(60@0.0) corner:(80@1.0).
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   201
        s3 thumbHeight:10.  'percent'.     
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   202
        s3 action:[:percent | blue := percent.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   203
                              l backgroundColor:(Color red:red green:green blue:blue)].
62
claus
parents: 49
diff changeset
   204
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   205
        l := Label in:top.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   206
        l origin:90@0.0 corner:1.0@1.0.
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   207
        l backgroundColor:Color black.
62
claus
parents: 49
diff changeset
   208
159
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   209
        top open
0596de11a136 examples
Claus Gittinger <cg@exept.de>
parents: 155
diff changeset
   210
                                                                        [exEnd]
48
c844acacf010 *** empty log message ***
claus
parents: 40
diff changeset
   211
"
11
793044d4bc90 *** empty log message ***
claus
parents: 8
diff changeset
   212
! !
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   213
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   214
!Slider methodsFor:'accessing'!
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   215
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   216
thumbHeight
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   217
    "redefined since a slider has no height - just origin"
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   218
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   219
    ^ nil
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   220
! !
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   221
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   222
!Slider methodsFor:'forced scroll'!
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   223
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   224
pageDown
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   225
    "ignored - a slider has no concept of page-wise scrolling"
8
91035a03b4cf *** empty log message ***
claus
parents: 4
diff changeset
   226
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   227
    ^ self
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   228
!
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   229
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   230
pageUp
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   231
    "ignored - a slider has no concept of page-wise scrolling"
24
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
   232
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   233
    ^ self
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   234
! !
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   235
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   236
!Slider methodsFor:'initialization'!
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   237
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   238
initStyle
165
b758808c4ab8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 159
diff changeset
   239
    <resource: #style (#sliderNTallyMarks #sliderTallyLevel)>
b758808c4ab8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 159
diff changeset
   240
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   241
    super initStyle.
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   242
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   243
    tallyMarks := StyleSheet at:'sliderNTallyMarks' default:1.
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   244
    tallyLevel := StyleSheet at:'sliderTallyLevel' default:-1.    
137
e4c9a7cc26d0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
   245
    thumbActiveLevel := thumbLevel.
e4c9a7cc26d0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 100
diff changeset
   246
165
b758808c4ab8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 159
diff changeset
   247
    "Modified: 30.4.1996 / 17:02:15 / cg"
49
claus
parents: 48
diff changeset
   248
!
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   249
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   250
initialize
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   251
    sliderHeight := (self verticalPixelPerMillimeter:10) rounded.
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   252
    super initialize.
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   253
    thumbHeight := 0.
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   254
! !
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   255
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   256
!Slider methodsFor:'private'!
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   257
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   258
absFromPercent:percent
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   259
    "given a percentage, compute number of pixels"
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   260
49
claus
parents: 48
diff changeset
   261
    |fullSize|
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   262
49
claus
parents: 48
diff changeset
   263
    (orientation == #vertical) ifTrue:[
claus
parents: 48
diff changeset
   264
	fullSize := height
claus
parents: 48
diff changeset
   265
    ] ifFalse:[
claus
parents: 48
diff changeset
   266
	fullSize := width
claus
parents: 48
diff changeset
   267
    ].
claus
parents: 48
diff changeset
   268
    ^ ((percent * (fullSize - sliderHeight - (margin * 2))) / 100) rounded
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   269
!
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   270
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   271
computeThumbFrame
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   272
    "redefined, since the thumb-height stays constant"
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   273
49
claus
parents: 48
diff changeset
   274
    |nh nw ny nx sz m|
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   275
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   276
    thumbHeight := 0.
49
claus
parents: 48
diff changeset
   277
    sz := (self absFromPercent:thumbOrigin) + margin.
claus
parents: 48
diff changeset
   278
    m := margin + inset.
claus
parents: 48
diff changeset
   279
    (orientation == #vertical) ifTrue:[
claus
parents: 48
diff changeset
   280
	ny := sz.
claus
parents: 48
diff changeset
   281
	nh := sliderHeight.
claus
parents: 48
diff changeset
   282
	nx := m.     
claus
parents: 48
diff changeset
   283
	nw := width - (2 * nx).
claus
parents: 48
diff changeset
   284
    ] ifFalse:[
claus
parents: 48
diff changeset
   285
	nx := sz.
claus
parents: 48
diff changeset
   286
	nw := sliderHeight.
claus
parents: 48
diff changeset
   287
	ny := m.     
claus
parents: 48
diff changeset
   288
	nh := height - (2 * ny).
claus
parents: 48
diff changeset
   289
    ].
claus
parents: 48
diff changeset
   290
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   291
    "
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   292
     do not create new Rectangle if its the same anyway
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   293
    "
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   294
    thumbFrame notNil ifTrue:[
24
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
   295
	(ny == thumbFrame top) ifTrue:[
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
   296
	  (nx == thumbFrame left) ifTrue:[
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
   297
	    (nh == thumbFrame height) ifTrue:[
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
   298
	      (nw == thumbFrame width) ifTrue:[ ^ self]
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
   299
	    ]
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
   300
	  ]
6704fad5eb7d *** empty log message ***
claus
parents: 11
diff changeset
   301
	]
0
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   302
    ].
0fd7841626f6 Initial revision
claus
parents:
diff changeset
   303
    thumbFrame := Rectangle left:nx top:ny width:nw height:nh
49
claus
parents: 48
diff changeset
   304
!
claus
parents: 48
diff changeset
   305
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   306
percentFromAbs:absValue
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   307
    "given a number of pixels, compute percentage"
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   308
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   309
    |fullSize val|
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   310
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   311
    (orientation == #vertical) ifTrue:[
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   312
	fullSize := height
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   313
    ] ifFalse:[
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   314
	fullSize := width
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   315
    ].
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   316
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   317
    val := absValue / (fullSize - sliderHeight - (margin * 2)) * (rangeEnd - rangeStart).
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   318
    val := val + rangeStart.
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   319
    val < rangeStart ifTrue:[^ rangeStart].
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   320
    val > rangeEnd ifTrue:[^ rangeEnd].
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   321
    ^ val
49
claus
parents: 48
diff changeset
   322
! !
claus
parents: 48
diff changeset
   323
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   324
!Slider class methodsFor:'documentation'!
49
claus
parents: 48
diff changeset
   325
100
3d33433f459c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   326
version
165
b758808c4ab8 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 159
diff changeset
   327
    ^ '$Header: /cvs/stx/stx/libwidg2/Slider.st,v 1.17 1996-04-30 15:37:30 cg Exp $'
49
claus
parents: 48
diff changeset
   328
! !