ArrowButton.st
author claus
Wed, 24 Aug 1994 01:38:59 +0200
changeset 51 e895ac4cc7c8
parent 38 4b9b70b2cc87
child 59 450ce95a72a4
permissions -rw-r--r--
support non-string entries
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     1
"
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     3
              All Rights Reserved
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     4
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
3ebee08bea15 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    11
"
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    12
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    13
Button subclass:#ArrowButton
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
    14
         instanceVariableNames:'passiveForm activeForm'
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
    15
         classVariableNames:'DownArrowForm UpArrowForm
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    16
                             LeftArrowForm RightArrowForm
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    17
                             CachedStyle'
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
    18
         poolDictionaries:''
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
    19
         category:'Views-Interactors'
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    20
!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    21
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    22
ArrowButton comment:'
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    23
COPYRIGHT (c) 1993 by Claus Gittinger
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    24
              All Rights Reserved
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    25
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    26
$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.5 1994-08-07 13:20:36 claus Exp $
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    27
'!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    28
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    29
!ArrowButton class methodsFor:'documentation'!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    30
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    31
copyright
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    32
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    33
 COPYRIGHT (c) 1993 by Claus Gittinger
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    34
              All Rights Reserved
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    35
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    36
 This software is furnished under a license and may be used
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    37
 only in accordance with the terms of that license and with the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    38
 inclusion of the above copyright notice.   This software may not
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    39
 be provided or otherwise made available to, or used by, any
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    40
 other person.  No title to or ownership of the software is
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    41
 hereby transferred.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    42
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    43
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    44
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    45
version
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    46
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    47
$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.5 1994-08-07 13:20:36 claus Exp $
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    48
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    49
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    50
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    51
documentation
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    52
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    53
    ArrowButtons display an arrow-bitmap as their label; they are mainly
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    54
    used for scrollbars, but can be useful on their own in some applications.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    55
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    56
    ArrowButtons are created by sending one of:
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    57
            ArrowButton upIn:aView /downIn: / leftIn: or rightIn:
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    58
    passing the parent view as argument.
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    59
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    60
    example1:
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    61
        |v p b1 b2 b3 b4|
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    62
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    63
        v := StandardSystemView new.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    64
        p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    65
        b1 := ArrowButton upIn:p.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    66
        b2 := ArrowButton downIn:p.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    67
        b3 := ArrowButton leftIn:p.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    68
        b4 := ArrowButton rightIn:p.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    69
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    70
        b1 action:['whatEver you like here ...'].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    71
        b2 action:['whatEver you like here ...'].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    72
        b3 action:['whatEver you like here ...'].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    73
        b4 action:['whatEver you like here ...'].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    74
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    75
        v open
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    76
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    77
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    78
    example2:
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    79
        |v p b1 b2 b3 b4|
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    80
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    81
        v := StandardSystemView new.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    82
        p := HorizontalPanelView origin:0.0 @ 0.0 corner:1.0 @ 1.0 in:v.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    83
        b1 := (ArrowButton upIn:p) extent:30@30.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    84
        b2 := (ArrowButton downIn:p) extent:30@30.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    85
        b3 := (ArrowButton leftIn:p) extent:30@30.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    86
        b4 := (ArrowButton rightIn:p) extent:30@30.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    87
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    88
        b1 action:['whatEver you like here ...'].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    89
        b2 action:['whatEver you like here ...'].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    90
        b3 action:['whatEver you like here ...'].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    91
        b4 action:['whatEver you like here ...'].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    92
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    93
        v open
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    94
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    95
! !
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    96
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    97
!ArrowButton class methodsFor:'defaults'!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
    98
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
    99
upArrowButtonForm:style on:aDevice
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   100
    "return the form used for the scrollUp Button"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   101
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   102
    |form fName|
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   103
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   104
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   105
     flush cached form on style-changes
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   106
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   107
    CachedStyle ~~ style ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   108
        DownArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   109
        UpArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   110
        LeftArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   111
        RightArrowForm := nil
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   112
    ].
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   113
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   114
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   115
     use cached form, if device is appropriate
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   116
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   117
    ((aDevice == Display) and:[UpArrowForm notNil]) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   118
        ^ UpArrowForm
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   119
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   120
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   121
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   122
     get bitmaps filename from resources, use a style-dependent
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   123
     default, if resources do not contain a filename
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   124
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   125
    style == #mswindows ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   126
        fName := 'ScrollUp_win.xbm'.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   127
    ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   128
        (style == #st80) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   129
            fName := 'ScrollUp_st.xbm'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   130
        ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   131
            fName := 'ScrollUp.xbm'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   132
        ]
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   133
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   134
    form := Form fromFile:(self classResources 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   135
                              at:'SCROLL_UP_BUTTON_FORM_FILE'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   136
                              default:fName)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   137
                 resolution:100
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   138
                         on:aDevice.
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   139
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   140
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   141
     form to use as a fallback, if no bitmap file is present
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   142
     (actually not really needed - just to show something useful, in
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   143
      case of a bad installation)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   144
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   145
    form isNil ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   146
        style == #st80 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   147
            form := Form width:9 height:9 depth:1 on:aDevice.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   148
            form clear.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   149
            form lineWidth:2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   150
            form capStyle:#round.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   151
            form paint:(Color colorId:1).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   152
            form displayLineFromX:0 y:6 toX:4 y:2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   153
            form displayLineFromX:4 y:2 toX:8 y:6.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   154
        ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   155
            form := Form width:16 height:16 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   156
                         fromArray:#(2r00000000 2r00000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   157
                                     2r00000001 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   158
                                     2r00000010 2r01000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   159
                                     2r00000100 2r00100000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   160
                                     2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   161
                                     2r00010000 2r00001000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   162
                                     2r00100000 2r00000100
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   163
                                     2r01000000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   164
                                     2r01111000 2r00011110
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   165
                                     2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   166
                                     2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   167
                                     2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   168
                                     2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   169
                                     2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   170
                                     2r00001111 2r11110000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   171
                                     2r00000000 2r00000000)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   172
                         on:aDevice
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   173
        ].
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   174
    ].
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   175
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   176
    form := form on:aDevice.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   177
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   178
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   179
     remember form for next use
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   180
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   181
    (aDevice == Display) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   182
        UpArrowForm := form
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   183
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   184
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   185
    CachedStyle := style.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   186
    ^ form
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   187
!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   188
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   189
downArrowButtonForm:style on:aDevice
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   190
    "retun the form used for the scrollDown Button"
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   191
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   192
    |form fName|
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   193
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   194
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   195
     flush cached form on style-changes
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   196
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   197
    CachedStyle ~~ style ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   198
        DownArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   199
        UpArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   200
        LeftArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   201
        RightArrowForm := nil
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   202
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   203
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   204
     use cached form, if device is appropriate
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   205
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   206
    ((aDevice == Display) and:[DownArrowForm notNil]) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   207
        ^ DownArrowForm
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   208
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   209
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   210
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   211
     get bitmaps filename from resources, use a style-dependent
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   212
     default, if resources do not contain a filename
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   213
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   214
    style == #mswindows ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   215
        fName := 'ScrollDn_win.xbm'.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   216
    ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   217
        (style == #st80) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   218
            fName := 'ScrollDn_st.xbm'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   219
        ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   220
            fName := 'ScrollDn.xbm'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   221
        ]
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   222
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   223
    form := Form fromFile:(self classResources 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   224
                              at:'SCROLL_DOWN_BUTTON_FORM_FILE'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   225
                              default:fName)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   226
                 resolution:100
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   227
                         on:aDevice.
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   228
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   229
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   230
     form to use as a fallback, if no bitmap file is present
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   231
     (actually not really needed - just to show something useful, in
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   232
      case of a bad installation)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   233
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   234
    form isNil ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   235
        style == #st80 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   236
            form := Form width:9 height:9 depth:1 on:Display.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   237
            form clear.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   238
            form lineWidth:2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   239
            form capStyle:#round.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   240
            form paint:(Color colorId:1).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   241
            form displayLineFromX:0 y:2 toX:4 y:6.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   242
            form displayLineFromX:4 y:6 toX:8 y:2 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   243
        ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   244
            form  := Form width:16 height:16 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   245
                          fromArray:#(2r00000000 2r00000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   246
                                      2r00001111 2r11110000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   247
                                      2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   248
                                      2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   249
                                      2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   250
                                      2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   251
                                      2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   252
                                      2r01111000 2r00011110
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   253
                                      2r01000000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   254
                                      2r00100000 2r00000100
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   255
                                      2r00010000 2r00001000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   256
                                      2r00001000 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   257
                                      2r00000100 2r00100000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   258
                                      2r00000010 2r01000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   259
                                      2r00000001 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   260
                                      2r00000000 2r00000000)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   261
                         on:aDevice
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   262
        ].
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   263
    ].
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   264
    form := form on:aDevice.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   265
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   266
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   267
     remember form for next use
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   268
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   269
    (aDevice == Display) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   270
        DownArrowForm := form
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   271
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   272
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   273
    CachedStyle := style.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   274
    ^ form
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   275
!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   276
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   277
leftArrowButtonForm:style on:aDevice
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   278
    "retun the form used for the scrollLeft Button"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   279
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   280
    |form fName|
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   281
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   282
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   283
     flush cached form on style-changes
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   284
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   285
    CachedStyle ~~ style ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   286
        DownArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   287
        UpArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   288
        LeftArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   289
        RightArrowForm := nil
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   290
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   291
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   292
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   293
     use cached form, if device is appropriate
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   294
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   295
    ((aDevice == Display) and:[LeftArrowForm notNil]) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   296
        ^ LeftArrowForm
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   297
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   298
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   299
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   300
     get bitmaps filename from resources, use a style-dependent
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   301
     default, if resources do not contain a filename
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   302
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   303
    style == #mswindows ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   304
        fName := 'ScrollLt_win.xbm'.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   305
    ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   306
        (style == #st80) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   307
            fName := 'ScrollLt_st.xbm'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   308
        ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   309
            fName := 'ScrollLt.xbm'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   310
        ]
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   311
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   312
    form := Form fromFile:(self classResources 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   313
                              at:'SCROLL_LEFT_BUTTON_FORM_FILE'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   314
                              default:fName)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   315
                 resolution:100
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   316
                         on:aDevice.
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   317
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   318
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   319
     form to use as a fallback, if no bitmap file is present
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   320
     (actually not really needed - just to show something useful, in
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   321
      case of a bad installation)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   322
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   323
    form isNil ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   324
        style == #st80 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   325
            form := Form width:9 height:9 depth:1 on:Display.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   326
            form clear.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   327
            form lineWidth:2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   328
            form capStyle:#round.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   329
            form paint:(Color colorId:1).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   330
            form displayLineFromX:6 y:0 toX:2 y:4.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   331
            form displayLineFromX:2 y:4 toX:6 y:8.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   332
        ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   333
            form := Form width:16 height:16 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   334
                         fromArray:#(2r00000000 2r00000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   335
                                     2r00000001 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   336
                                     2r00000010 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   337
                                     2r00000100 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   338
                                     2r00001000 2r11111110
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   339
                                     2r00010000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   340
                                     2r00100000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   341
                                     2r01000000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   342
                                     2r01000000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   343
                                     2r00100000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   344
                                     2r00010000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   345
                                     2r00001000 2r11111110
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   346
                                     2r00000100 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   347
                                     2r00000010 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   348
                                     2r00000001 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   349
                                     2r00000000 2r00000000)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   350
                         on:aDevice
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   351
        ].
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   352
    ].
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   353
    form := form on:aDevice.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   354
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   355
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   356
     remember form for next use
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   357
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   358
    (aDevice == Display) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   359
        LeftArrowForm := form
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   360
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   361
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   362
    CachedStyle := style.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   363
    ^ form
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   364
!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   365
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   366
rightArrowButtonForm:style on:aDevice
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   367
    "retun the form used for the scrollRight Button"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   368
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   369
    |form fName|
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   370
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   371
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   372
     flush cached form on style-changes
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   373
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   374
    CachedStyle ~~ style ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   375
        DownArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   376
        UpArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   377
        LeftArrowForm := nil.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   378
        RightArrowForm := nil
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   379
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   380
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   381
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   382
     use cached form, if device is appropriate
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   383
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   384
    ((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   385
        ^ RightArrowForm
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   386
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   387
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   388
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   389
     get bitmaps filename from resources, use a style-dependent
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   390
     default, if resources do not contain a filename
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   391
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   392
    style == #mswindows ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   393
        fName := 'ScrollRt_win.xbm'.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   394
    ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   395
        (style == #st80) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   396
            fName := 'ScrollRt_st.xbm'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   397
        ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   398
            fName := 'ScrollRt.xbm'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   399
        ]
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   400
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   401
    form := Form fromFile:(self classResources 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   402
                              at:'SCROLL_RIGHT_BUTTON_FORM_FILE'
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   403
                              default:fName)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   404
                 resolution:100
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   405
                         on:aDevice.
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   406
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   407
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   408
     form to use as a fallback, if no bitmap file is present
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   409
     (actually not really needed - just to show something useful, in
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   410
      case of a bad installation)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   411
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   412
    form isNil ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   413
        style == #st80 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   414
            form := Form width:9 height:9 depth:1 on:Display.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   415
            form clear.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   416
            form lineWidth:2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   417
            form capStyle:#round.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   418
            form paint:(Color colorId:1).
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   419
            form displayLineFromX:2 y:0 toX:6 y:4.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   420
            form displayLineFromX:6 y:4 toX:2 y:8 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   421
        ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   422
            form := Form width:16 height:16 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   423
                         fromArray:#(2r00000000 2r00000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   424
                                     2r00000001 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   425
                                     2r00000001 2r01000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   426
                                     2r00000001 2r00100000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   427
                                     2r01111111 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   428
                                     2r01000000 2r00001000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   429
                                     2r01000000 2r00000100
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   430
                                     2r01000000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   431
                                     2r01000000 2r00000010
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   432
                                     2r01000000 2r00000100
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   433
                                     2r01000000 2r00001000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   434
                                     2r01111111 2r00010000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   435
                                     2r00000001 2r00100000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   436
                                     2r00000001 2r01000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   437
                                     2r00000001 2r10000000
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   438
                                     2r00000000 2r00000000)
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   439
                         on:aDevice
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   440
        ].
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   441
    ].
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   442
    form := form on:aDevice.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   443
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   444
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   445
     remember form for next use
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   446
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   447
    (aDevice == Display) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   448
        RightArrowForm := form
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   449
    ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   450
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   451
    CachedStyle := style.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   452
    ^ form
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   453
! !
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   454
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   455
!ArrowButton class methodsFor:'instance creation'!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   456
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   457
upIn:aView
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   458
    ^ (super in:aView) direction:#up
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   459
!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   460
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   461
downIn:aView
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   462
    ^ (super in:aView) direction:#down
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   463
!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   464
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   465
leftIn:aView
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   466
    ^ (super in:aView) direction:#left
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   467
!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   468
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   469
rightIn:aView
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   470
    ^ (super in:aView) direction:#right
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   471
! !
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   472
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   473
!ArrowButton methodsFor:'accessing'!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   474
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   475
direction:aDirectionSymbol
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   476
    |form|
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   477
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   478
    aDirectionSymbol == #up ifTrue:[
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   479
        form := (self class upArrowButtonForm:style on:device)
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   480
    ].
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   481
    aDirectionSymbol == #down ifTrue:[
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   482
        form := (self class downArrowButtonForm:style on:device)
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   483
    ].
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   484
    aDirectionSymbol == #left ifTrue:[
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   485
        form := (self class leftArrowButtonForm:style on:device)
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   486
    ].
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   487
    aDirectionSymbol == #right ifTrue:[
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   488
        form := (self class rightArrowButtonForm:style on:device)
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   489
    ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   490
    self form:form
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   491
! !
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   492
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   493
!ArrowButton methodsFor:'initialization'!
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   494
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   495
initStyle
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   496
    super initStyle.
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   497
    style == #motif ifTrue:[
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   498
        onLevel := 0.
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   499
        offLevel := 0.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   500
        self level:0.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   501
        bgColor := viewBackground.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   502
        fgColor := viewBackground.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   503
        activeFgColor := Color darkGrey.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   504
    ] ifFalse:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   505
        (style == #st80) ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   506
            activeFgColor := White
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   507
        ]
1
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   508
    ]
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   509
! !
3ebee08bea15 Initial revision
claus
parents:
diff changeset
   510
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   511
!ArrowButton methodsFor:'redrawing'!
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   512
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   513
drawWith:fg and:bg
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   514
    "this is a q&d hack for motif ..."
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   515
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   516
    |topLeft botRight deep|
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   517
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   518
    style ~~ #motif ifTrue:[
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   519
        ^ super drawWith:fg and:bg.
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   520
    ].
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   521
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   522
    logo notNil ifTrue:[
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   523
        shadowColor := Black.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   524
        lightColor := White.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   525
        deep := false.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   526
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   527
"/        shadowColor := shadowColor on:device.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   528
"/        lightColor := lightColor on:device.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   529
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   530
"/        shadowColor ditherForm notNil ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   531
"/            shadowColor := Black on:device
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   532
"/        ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   533
"/        lightColor ditherForm notNil ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   534
"/            lightColor := White on:device
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   535
"/        ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   536
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   537
        pressed ifTrue:[
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   538
            topLeft := shadowColor.
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   539
            botRight := lightColor
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   540
        ] ifFalse:[
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   541
            topLeft := lightColor.
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   542
            botRight := shadowColor
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   543
        ].
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   544
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   545
        self paint:bg.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   546
        self fillRectangleX:0 y:0 width:width height:height.
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   547
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   548
        deep ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   549
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   550
            self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 1 .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   551
            botRight colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   552
                self foreground:botRight background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   553
                self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 1.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   554
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   555
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   556
            self displayOpaqueForm:logo x:labelOriginX   y:labelOriginY + 1 .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   557
            botRight colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   558
                self foreground:botRight background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   559
                self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 1.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   560
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   561
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   562
            self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 2 .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   563
            botRight colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   564
                self foreground:botRight background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   565
                self displayOpaqueForm:logo x:labelOriginX-1 y:labelOriginY + 2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   566
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   567
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   568
            self displayOpaqueForm:logo x:labelOriginX   y:labelOriginY + 2 .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   569
            botRight colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   570
                self foreground:botRight background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   571
                self displayOpaqueForm:logo x:labelOriginX y:labelOriginY + 2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   572
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   573
        ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   574
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   575
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   576
        deep ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   577
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   578
            self displayOpaqueForm:logo x:labelOriginX-2   y:labelOriginY - 2 .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   579
            topLeft colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   580
                self foreground:topLeft background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   581
                self displayOpaqueForm:logo x:labelOriginX-2  y:labelOriginY - 2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   582
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   583
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   584
        self foreground:(Color noColor) background:(Color allColor) function:#and.
24
966098a893f8 *** empty log message ***
claus
parents: 18
diff changeset
   585
        self displayOpaqueForm:logo x:labelOriginX-1   y:labelOriginY - 1 .
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   586
        topLeft colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   587
            self foreground:topLeft background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   588
            self displayOpaqueForm:logo x:labelOriginX-1  y:labelOriginY - 1.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   589
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   590
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   591
        deep ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   592
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   593
            self displayOpaqueForm:logo x:labelOriginX   y:labelOriginY - 2 .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   594
            topLeft colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   595
                self foreground:topLeft background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   596
                self displayOpaqueForm:logo x:labelOriginX  y:labelOriginY - 2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   597
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   598
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   599
        self foreground:(Color noColor) background:(Color allColor) function:#and.
24
966098a893f8 *** empty log message ***
claus
parents: 18
diff changeset
   600
        self displayOpaqueForm:logo x:labelOriginX   y:labelOriginY - 1 .
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   601
        topLeft colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   602
            self foreground:topLeft background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   603
            self displayOpaqueForm:logo x:labelOriginX  y:labelOriginY - 1.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   604
        ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   605
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   606
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   607
        deep ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   608
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   609
            self displayOpaqueForm:logo x:labelOriginX -2   y:labelOriginY  .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   610
            topLeft colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   611
                self foreground:topLeft background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   612
                self displayOpaqueForm:logo x:labelOriginX -2 y:labelOriginY .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   613
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   614
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   615
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   616
        self foreground:(Color noColor) background:(Color allColor) function:#and.
24
966098a893f8 *** empty log message ***
claus
parents: 18
diff changeset
   617
        self displayOpaqueForm:logo x:labelOriginX -1   y:labelOriginY  .
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   618
        topLeft colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   619
            self foreground:topLeft background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   620
            self displayOpaqueForm:logo x:labelOriginX -1 y:labelOriginY .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   621
        ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   622
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   623
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   624
        deep ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   625
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   626
            self displayOpaqueForm:logo x:labelOriginX + 2  y:labelOriginY  .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   627
            botRight colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   628
                self foreground:botRight background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   629
                self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   630
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   631
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   632
        self foreground:(Color noColor) background:(Color allColor) function:#and.
24
966098a893f8 *** empty log message ***
claus
parents: 18
diff changeset
   633
        self displayOpaqueForm:logo x:labelOriginX + 1  y:labelOriginY  .
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   634
        botRight colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   635
            self foreground:botRight background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   636
            self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   637
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   638
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   639
        deep ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   640
            self foreground:(Color noColor) background:(Color allColor) function:#and.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   641
            self displayOpaqueForm:logo x:labelOriginX + 2  y:labelOriginY + 2 .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   642
            botRight colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   643
                self foreground:botRight background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   644
                self displayOpaqueForm:logo x:labelOriginX + 2 y:labelOriginY + 2.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   645
            ].
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   646
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   647
        self foreground:(Color noColor) background:(Color allColor) function:#and.
24
966098a893f8 *** empty log message ***
claus
parents: 18
diff changeset
   648
        self displayOpaqueForm:logo x:labelOriginX + 1  y:labelOriginY + 1 .
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   649
        botRight colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   650
            self foreground:botRight background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   651
            self displayOpaqueForm:logo x:labelOriginX + 1 y:labelOriginY + 1.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   652
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   653
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   654
        self foreground:(Color noColor) background:(Color allColor) function:#and.
24
966098a893f8 *** empty log message ***
claus
parents: 18
diff changeset
   655
        self displayOpaqueForm:logo x:labelOriginX   y:labelOriginY  .
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   656
        fg colorId ~~ 0 ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   657
            self foreground:fg background:(Color noColor) function:#or.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   658
            self displayOpaqueForm:logo x:labelOriginX  y:labelOriginY .
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
   659
        ].
6
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   660
        self function:#copy
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   661
    ]
fd1b68b48422 *** empty log message ***
claus
parents: 1
diff changeset
   662
! !