"
COPYRIGHT (c) 1995 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libtool2' }"
SimpleDialog subclass:#ColorEditDialog
instanceVariableNames:'red green blue hue light saturation colorNameHolder'
classVariableNames:''
poolDictionaries:''
category:'Interface-UIPainter'
!
!ColorEditDialog class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1995 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
An edit-dialog for colors.
"
!
examples
"
[exBegin]
|editor color|
editor := ColorEditDialog new.
editor color:(Color green).
editor open.
editor accepted ifTrue:[
editor color inspect.
]
[exEnd]
"
! !
!ColorEditDialog class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:ColorEditor andSelector:#windowSpec
ColorEditor new openInterface:#windowSpec
ColorEditor open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'Define Color'
name: 'Define Color'
min: (Point 340 260)
max: (Point nil 260)
bounds: (Rectangle 0 0 453 260)
)
component:
(SpecCollection
collection: (
(VerticalPanelViewSpec
name: 'RGBLabelPanel'
layout: (LayoutFrame 0 0 0 0 58 0 76 0)
horizontalLayout: fit
verticalLayout: spreadSpace
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Red:'
name: 'RedLabel'
translateLabel: true
adjust: right
useDefaultExtent: true
)
(LabelSpec
label: 'Green:'
name: 'GreenLabel'
translateLabel: true
adjust: right
useDefaultExtent: true
)
(LabelSpec
label: 'Blue:'
name: 'BlueLabel'
translateLabel: true
adjust: right
useDefaultExtent: true
)
)
)
)
(VerticalPanelViewSpec
name: 'RGBSliderPanel'
layout: (LayoutFrame 62 0 0 0 -166 1 76 0)
horizontalLayout: fit
verticalLayout: spreadSpace
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(SliderSpec
name: 'RedSlider'
tabable: false
model: red
orientation: horizontal
stop: 255
step: 1
backgroundColor: (Color 100.0 0.0 0.0)
extent: (Point 225 16)
)
(SliderSpec
name: 'GreenSlider'
tabable: false
model: green
orientation: horizontal
stop: 255
step: 1
backgroundColor: (Color 0.0 100.0 0.0)
extent: (Point 225 16)
)
(SliderSpec
name: 'BlueSlider'
tabable: false
model: blue
orientation: horizontal
stop: 255
step: 1
backgroundColor: (Color 0.0 0.0 100.0)
extent: (Point 225 16)
)
)
)
)
(VerticalPanelViewSpec
name: 'RGBFieldPanel'
layout: (LayoutFrame -161 1 0 0 -123 1 76 0)
horizontalLayout: fit
verticalLayout: spreadSpace
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(InputFieldSpec
name: 'RedField'
model: red
type: numberInRange
numChars: 3
minValue: 0
maxValue: 255
acceptOnPointerLeave: false
extent: (Point 38 20)
)
(InputFieldSpec
name: 'GreenField'
model: green
type: numberInRange
numChars: 3
minValue: 0
maxValue: 255
acceptOnPointerLeave: false
extent: (Point 38 20)
)
(InputFieldSpec
name: 'BlueField'
model: blue
type: numberInRange
numChars: 3
minValue: 0
maxValue: 255
acceptOnPointerLeave: false
extent: (Point 38 20)
)
)
)
)
(VerticalPanelViewSpec
name: 'HLSLabelPanel'
layout: (LayoutFrame 0 0 86 0 58 0 163 0)
horizontalLayout: fit
verticalLayout: spreadSpace
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Hue:'
name: 'Label1'
translateLabel: true
adjust: right
useDefaultExtent: true
)
(LabelSpec
label: 'Light:'
name: 'Label2'
translateLabel: true
adjust: right
useDefaultExtent: true
)
(LabelSpec
label: 'Sat:'
name: 'Label3'
translateLabel: true
adjust: right
useDefaultExtent: true
)
)
)
)
(VerticalPanelViewSpec
name: 'HLSSliderPanel'
layout: (LayoutFrame 62 0 86 0 -166 1 163 0)
horizontalLayout: fit
verticalLayout: spreadSpace
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(SliderSpec
name: 'Slider1'
tabable: false
model: hue
orientation: horizontal
stop: 359
step: 1
keyboardStep: 1
extent: (Point 225 16)
)
(SliderSpec
name: 'Slider2'
tabable: false
model: light
orientation: horizontal
step: 1
backgroundColor: (Color 66.9993 66.9993 66.9993)
keyboardStep: 1
extent: (Point 225 16)
)
(SliderSpec
name: 'Slider3'
tabable: false
model: saturation
orientation: horizontal
step: 1
backgroundColor: (Color 66.9993 66.9993 66.9993)
keyboardStep: 1
extent: (Point 225 16)
)
)
)
)
(VerticalPanelViewSpec
name: 'HLSFieldPanel'
layout: (LayoutFrame -161 1 86 0 -123 1 163 0)
horizontalLayout: fit
verticalLayout: spreadSpace
horizontalSpace: 3
verticalSpace: 3
component:
(SpecCollection
collection: (
(InputFieldSpec
name: 'EntryField1'
model: hue
type: numberInRange
numChars: 3
minValue: 0
maxValue: 359
acceptOnPointerLeave: false
extent: (Point 38 20)
)
(InputFieldSpec
name: 'EntryField2'
model: light
type: numberInRange
numChars: 3
minValue: 0
maxValue: 100
acceptOnPointerLeave: false
extent: (Point 38 20)
)
(InputFieldSpec
name: 'EntryField3'
model: saturation
type: numberInRange
numChars: 3
minValue: 0
maxValue: 100
acceptOnPointerLeave: false
extent: (Point 38 20)
)
)
)
)
(ViewSpec
name: 'Box1'
layout: (LayoutFrame -117 1 4 0.0 -3 1.0 -39 1.0)
level: 1
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Preview'
name: 'PreviewBox'
layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -2 1.0)
level: -1
translateLabel: true
)
)
)
)
(LabelSpec
label: 'Color Name:'
name: 'ColorNameLabel'
layout: (LayoutFrame 0 0 190 0 106 0 212 0)
translateLabel: true
adjust: right
)
(InputFieldSpec
name: 'ColorNameField'
layout: (LayoutFrame 110 0 190 0 -123 1 212 0)
model: colorNameHolder
immediateAccept: true
acceptOnReturn: true
acceptOnTab: true
acceptOnLostFocus: true
acceptOnPointerLeave: false
)
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0.0 -32 1 0 1.0 0 1.0)
horizontalLayout: fitSpace
verticalLayout: centerMax
horizontalSpace: 3
verticalSpace: 3
reverseOrderIfOKAtLeft: true
component:
(SpecCollection
collection: (
(ActionButtonSpec
label: 'Cancel'
name: 'CancelButton'
translateLabel: true
resizeForLabel: false
tabable: true
model: cancel
useDefaultExtent: true
)
(ActionButtonSpec
label: 'OK'
name: 'OKButton'
translateLabel: true
resizeForLabel: false
tabable: true
model: accept
isDefault: true
defaultable: true
useDefaultExtent: true
)
)
)
)
)
)
)
! !
!ColorEditDialog methodsFor:'accessing'!
color
^Color redByte:(red value) greenByte:(green value) blueByte:(blue value)
!
color:aColor
aColor notNil ifTrue:[
self red value:aColor redByte.
self green value:aColor greenByte.
self blue value:aColor blueByte.
]
!
colorName
^ colorNameHolder value
! !
!ColorEditDialog methodsFor:'actions'!
colorChanged
|box clr|
box := self componentAt: #PreviewBox.
box isNil ifTrue:[^ self "called before setup"].
clr := self color.
box backgroundColor:clr.
box foregroundColor:(clr brightness < 0.5
ifTrue:[Color white]
ifFalse:[Color black]).
!
colorNameChanged
"compute rgb and hls (if possible)"
|clr h|
clr := Color name:colorNameHolder value ifIllegal:nil.
clr isNil ifTrue:[
^ self
].
red value:clr redByte withoutNotifying:self.
green value:clr greenByte withoutNotifying:self.
blue value:clr blueByte withoutNotifying:self.
h := clr hue.
h notNil ifTrue:[
hue value:(h rounded) withoutNotifying:self.
].
light value:(clr light rounded) withoutNotifying:self.
saturation value:(clr saturation rounded) withoutNotifying:self.
self colorChanged
!
hlsSliderChanged
"compute rgb"
Color withRGBFromHue:hue value light:light value saturation:saturation value do:[:r :g :b |
red value:(r * 255 / 100) rounded withoutNotifying:self.
green value:(g * 255 / 100) rounded withoutNotifying:self.
blue value:(b * 255 / 100) rounded withoutNotifying:self.
].
colorNameHolder value:'' withoutNotifying:self.
self colorChanged
!
rgbSliderChanged
"compute hls"
|r g b|
r := self red value.
g := self green value.
b := self blue value.
Color withHLSFromRed:(r * 100 / 255) green:(g * 100 / 255) blue:(b * 100 / 255) do:[:h :l :s |
h isNil ifTrue:[
"/ achromatic
] ifFalse:[
self hue value:(h rounded) withoutNotifying:self.
].
self light value:(l rounded) withoutNotifying:self.
self saturation value:(s rounded) withoutNotifying:self.
].
self colorNameHolder value:'' withoutNotifying:self.
self colorChanged
! !
!ColorEditDialog methodsFor:'aspects'!
blue
blue isNil ifTrue:[
blue := 0 asValue.
blue addDependent:self.
].
^blue
!
colorNameHolder
colorNameHolder isNil ifTrue:[
colorNameHolder := '' asValue.
colorNameHolder addDependent:self.
].
^colorNameHolder
!
green
green isNil ifTrue:[
green := 0 asValue.
green addDependent:self.
].
^green
!
hue
hue isNil ifTrue:[
hue := 0 asValue.
hue addDependent:self.
].
^hue
!
light
light isNil ifTrue:[
light := 0 asValue.
light addDependent:self.
].
^light
!
red
red isNil ifTrue:[
red := 0 asValue.
red addDependent:self.
].
^red
!
saturation
saturation isNil ifTrue:[
saturation := 0 asValue.
saturation addDependent:self.
].
^saturation
! !
!ColorEditDialog methodsFor:'change & update'!
update:something with:aParameter from:changedObject
(changedObject == red
or:[changedObject == green
or:[changedObject == blue]]) ifTrue:[
^ self rgbSliderChanged
].
(changedObject == hue
or:[changedObject == light
or:[changedObject == saturation]]) ifTrue:[
^ self hlsSliderChanged
].
(changedObject == colorNameHolder) ifTrue:[
^ self colorNameChanged
].
^ super update:something with:aParameter from:changedObject
! !
!ColorEditDialog methodsFor:'startup & release'!
postBuildWith:aBuilder
super postBuildWith:aBuilder.
self colorChanged.
"Modified: / 6.9.1998 / 22:55:25 / cg"
! !
!ColorEditDialog class methodsFor:'documentation'!
version
^ '$Header$'
! !