LabelAndTwoIcons.st
author Jan Vrany <jan.vrany@labware.com>
Fri, 02 Sep 2022 11:25:39 +0100
branchjv
changeset 6261 9b7eb7159d29
parent 5210 be1d9fbaa48d
permissions -rw-r--r--
Fix loong standing bug with some menus not being translated / resolved This has happened with browser "View" menu when sometimes it had the slice resolved and sometimes not. It turned out that it was because the code disabled resources (and therefore slices) resolution when processing shortcuts, so the menu was created and cached unresolved. This fixes the issue. eXept apparently run into the same problem.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3871
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     1
"
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     2
 COPYRIGHT (c) 2009 by eXept Software AG
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     3
              All Rights Reserved
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     4
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     5
 This software is furnished under a license and may be used
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     6
 only in accordance with the terms of that license and with the
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     8
 be provided or otherwise made available to, or used by, any
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
     9
 other person.  No title to or ownership of the software is
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    10
 hereby transferred.
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    11
"
3783
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
"{ Package: 'stx:libwidg2' }"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
5210
be1d9fbaa48d #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 3871
diff changeset
    14
"{ NameSpace: Smalltalk }"
be1d9fbaa48d #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 3871
diff changeset
    15
3783
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
LabelAndIcon subclass:#LabelAndTwoIcons
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	instanceVariableNames:'image2'
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	classVariableNames:''
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	poolDictionaries:''
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	category:'Views-Support'
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!LabelAndTwoIcons class methodsFor:'documentation'!
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
3871
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    25
copyright
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    26
"
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    27
 COPYRIGHT (c) 2009 by eXept Software AG
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    28
              All Rights Reserved
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    29
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    30
 This software is furnished under a license and may be used
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    31
 only in accordance with the terms of that license and with the
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    33
 be provided or otherwise made available to, or used by, any
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    34
 other person.  No title to or ownership of the software is
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    35
 hereby transferred.
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    36
"
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    37
!
185109a66d51 added: #copyright
Claus Gittinger <cg@exept.de>
parents: 3795
diff changeset
    38
3783
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
documentation
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    like a LabelAndIcon, but adds another image to the right of the string.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    Notice:
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
        This is different from ST-80's LabelAndIcon class, which
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
        inherits from Label. Therefore, things may change in the future.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    [author:]
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
        Claus Gittinger
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    [see also:]
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
        ListEntry Text String Icon
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
        ListView SelectionInListView
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
!
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
examples
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
  in a button/label:
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
                                                                        [exBegin]
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
    |top l image|
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
    image := Image fromFile:'../../goodies/bitmaps/xpmBitmaps/countries/brazil.xpm'.
3794
cd7760f3dd4f changed: #examples
Claus Gittinger <cg@exept.de>
parents: 3783
diff changeset
    63
    l := (LabelAndTwoIcons icon:image string:'brazil').
cd7760f3dd4f changed: #examples
Claus Gittinger <cg@exept.de>
parents: 3783
diff changeset
    64
    l image2:image.
3783
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    top := Button label:l.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
    top open.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
                                                                        [exEnd]
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
  two images in a button/label:
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
                                                                        [exBegin]
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
    |top l image1 image2|
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
    image1 := Image fromFile:'../../goodies/bitmaps/xpmBitmaps/countries/brazil.xpm'.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
    image2 := Image fromFile:'../../goodies/bitmaps/xpmBitmaps/countries/germany.xpm'.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
    l := (LabelAndIcon form:image1 image:image2 string:'directory').
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
    top := Button label:l.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
    top open.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
                                                                        [exEnd]
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
! !
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
!LabelAndTwoIcons methodsFor:'accessing'!
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
image2
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
    "return my second image (right of string)"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
    ^ image2
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
!
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
image2:anImage
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
    "set the image2 (right of string)"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
    image2 := anImage
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
! !
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
!LabelAndTwoIcons methodsFor:'displaying'!
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
displayOn:aGC x:x y:y opaque:opaque
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
    "display the receiver on a GC"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    |y1 x1 image2Value image2Height maxHeight asc|
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
    super displayOn:aGC x:x y:y opaque:opaque.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    image2Value := image2 value.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    image2Value notNil ifTrue:[
5210
be1d9fbaa48d #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 3871
diff changeset
   108
        asc  := aGC deviceFont ascent.
3783
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
        image2Height  := image2Value notNil ifTrue:[image2Value height]  ifFalse:[0].
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
        maxHeight := self heightOn:aGC.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
        x1 := x  + gap + (super widthOn:aGC).
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
        image2Value notNil ifTrue:[
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
            y1 := y - asc + (maxHeight - image2Height + 1 // 2).
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
            image2 := image2Value onDevice:aGC device.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
            (opaque and:[image2Value mask isNil]) ifTrue:[aGC displayOpaqueForm:image2Value x:x1 y:y1]
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
                                                 ifFalse:[aGC displayForm:image2Value x:x1 y:y1].
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
        ].
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
    ]
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
! !
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
!LabelAndTwoIcons methodsFor:'queries'!
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
3795
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   126
heightOn:aGC
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   127
    "return the height of the receiver, if it is to be displayed on aGC"
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   128
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   129
    |image2Height oneMillimeter|
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   130
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   131
    image2 notNil ifTrue:[
5210
be1d9fbaa48d #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 3871
diff changeset
   132
        oneMillimeter := aGC device isNil ifTrue:[2] ifFalse:[aGC verticalIntegerPixelPerMillimeter].
3795
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   133
        image2Height := image2 value height + oneMillimeter
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   134
    ] ifFalse:[
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   135
        image2Height := 0   
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   136
    ].
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   137
    ^ (super heightOn:aGC) max: image2Height
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   138
!
4c76861a687d added: #heightOn:
Claus Gittinger <cg@exept.de>
parents: 3794
diff changeset
   139
3783
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
widthOn:aGC
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
    "return the width of the receiver, if it is to be displayed on aGC"
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
    |width|
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
    width := super widthOn:aGC.
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
    image2 notNil ifTrue:[
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
        width := width + gap + image2 value width
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
    ].
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
    ^ width
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
! !
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
!LabelAndTwoIcons class methodsFor:'documentation'!
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
version_CVS
5210
be1d9fbaa48d #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 3871
diff changeset
   155
    ^ '$Header$'
3783
b0aa88fecf39 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
! !
5210
be1d9fbaa48d #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 3871
diff changeset
   157