RoundButton.st
author Jan Vrany <jan.vrany@labware.com>
Fri, 02 Sep 2022 11:25:39 +0100
branchjv
changeset 6261 9b7eb7159d29
parent 4770 6634b540fea2
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:
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
     1
"
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
     3
	      All Rights Reserved
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
     4
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    11
"
4770
6634b540fea2 Added PluggableHierarchicalList to define ad-hoc tree models.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3150
diff changeset
    12
"{ Package: 'stx:libwidg2' }"
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    13
4770
6634b540fea2 Added PluggableHierarchicalList to define ad-hoc tree models.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3150
diff changeset
    14
"{ NameSpace: Smalltalk }"
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
    15
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    16
Button subclass:#RoundButton
1232
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    17
	instanceVariableNames:''
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    18
	classVariableNames:''
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    19
	poolDictionaries:''
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    20
	category:'Views-Interactors'
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    21
!
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    22
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    23
!RoundButton class methodsFor:'documentation'!
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    24
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    25
copyright
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    26
"
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    27
 COPYRIGHT (c) 1993 by Claus Gittinger
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    28
	      All Rights Reserved
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    29
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    30
 This software is furnished under a license and may be used
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    31
 only in accordance with the terms of that license and with the
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    33
 be provided or otherwise made available to, or used by, any
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    34
 other person.  No title to or ownership of the software is
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    35
 hereby transferred.
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    36
"
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    37
!
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    38
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    39
documentation
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    40
"
1232
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    41
    this is not finished - please do not look at it
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    42
    and do not use it (i.e. simply ignore it ;-).
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    43
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    44
    Notice - this only works under graphic displays which
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    45
    support arbitrary shaped views (i.e. XWindow).
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    46
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    47
    Under Win32, you will see a rectanglular view instead.
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    48
"
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    49
!
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    50
1232
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    51
examples
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    52
"
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    53
    |top b|
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    54
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    55
    top := StandardSystemView extent:300@300.
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    56
    b := RoundButton label:'hello' in:top.
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    57
    top open
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    58
"
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    59
! !
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    60
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    61
!RoundButton methodsFor:'drawing'!
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    62
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    63
drawWith:fg and:bg
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    64
    self paint:bg.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    65
    self fillRectangleX:0 y:0 width:width height:height.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    66
    super drawWith:fg and:bg
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    67
! !
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    68
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    69
!RoundButton methodsFor:'private'!
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    70
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    71
roundCornerFormWidth:width height:height offset:off
7
19b36b78ee01 *** empty log message ***
claus
parents: 1
diff changeset
    72
    |form wCorn hCorn wCornHalf wCornHalfRest hCornHalf hCornHalfRest
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    73
     left top right bot w h|
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    74
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    75
     "compute a shape form"
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    76
     form := Form width:width height:height.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    77
     form fill:(Color colorId:0).
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    78
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    79
     left := off. right := width-(off*2)-1.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    80
     top := off. bot := height-(2*off)-1.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    81
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    82
     w := width - off - off.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    83
     h := height - off - off.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    84
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    85
     wCorn := (w * 0.33) rounded asInteger.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    86
     hCorn := (h * 0.75) rounded asInteger.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    87
     wCornHalf := wCorn // 2.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    88
     hCornHalf := hCorn // 2.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    89
     wCorn odd ifTrue:[
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    90
	 wCornHalfRest := 1
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    91
     ] ifFalse:[
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    92
	 wCornHalfRest := 0
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    93
     ].
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    94
     hCorn odd ifTrue:[
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    95
	 hCornHalfRest := 1
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    96
     ] ifFalse:[
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
    97
	 hCornHalfRest := 0
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    98
     ].
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    99
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   100
     form paint:(Color colorId:1).
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   101
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   102
     form fillArcX:left y:top w:wCorn h:hCorn from:0 angle:360.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   103
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
   104
     form fillRectangleX:(left + wCornHalf) y:top
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
   105
			 width:(w - wCorn + wCornHalfRest) height:hCornHalf.
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   106
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   107
     "top right arc"
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   108
     form fillArcX:(right - wCorn) y:top w:wCorn h:hCorn from:0 angle:90.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   109
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   110
     "big middle rect"
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   111
     form fillRectangleX:left y:(top + hCornHalf)
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
   112
		    width:w height:(h - hCorn + hCornHalfRest).
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   113
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   114
     "bottom left arc"
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   115
     form fillArcX:left y:(bot - hCorn) w:wCorn h:hCorn from:180 angle:90.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   116
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   117
     "bottom rect"
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   118
     form fillRectangleX:(left + wCornHalf) y:(bot - hCornHalf)
86
4d7dbb5f1719 uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents: 7
diff changeset
   119
		    width:(w - wCorn + wCornHalfRest) height:hCornHalf.
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   120
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   121
     "bottom right arc"
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   122
     form fillArcX:(right - wCorn) y:(bot - hCorn) w:wCorn h:hCorn from:270 angle:90.
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   123
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   124
     ^ form
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
   125
! !
1232
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   126
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   127
!RoundButton methodsFor:'window events'!
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   128
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   129
sizeChanged:how
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   130
    |shapeForm borderForm|
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   131
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   132
    super sizeChanged:how.
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   133
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   134
    "compute a new shape form"
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   135
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
   136
    borderForm := self roundCornerFormWidth:width+(borderWidth * 2)
1232
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   137
				     height:height+(borderWidth * 2)
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   138
				     offset:0.
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
   139
    shapeForm := self roundCornerFormWidth:width+(borderWidth * 2)
1232
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   140
				    height:height+(borderWidth * 2)
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   141
				    offset:borderWidth.
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   142
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   143
    self borderShape:borderForm.
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   144
    self viewShape:shapeForm
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   145
! !
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   146
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   147
!RoundButton class methodsFor:'documentation'!
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   148
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   149
version
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
   150
    ^ '$Header: /cvs/stx/stx/libwidg2/RoundButton.st,v 1.5 2006-11-13 16:11:31 cg Exp $'
1232
e501018bd562 comment
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   151
! !
4770
6634b540fea2 Added PluggableHierarchicalList to define ad-hoc tree models.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3150
diff changeset
   152