author | Claus Gittinger <cg@exept.de> |
Tue, 04 Sep 2012 01:09:05 +0200 | |
changeset 2912 | 6e62954c5f35 |
parent 2904 | bd6cacbab203 |
child 2941 | 15df48eba1c4 |
permissions | -rw-r--r-- |
" 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 htmlColorNameHolder colorDefinitionStringHolder previewBox brightnessStringHolder' 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:'help specs'! flyByHelpSpec "This resource specification was automatically generated by the UIHelpTool of ST/X." "Do not manually edit this!! If it is corrupted, the UIHelpTool may not be able to read the specification." " UIHelpTool openOnClass:ColorEditDialog " <resource: #help> ^ super flyByHelpSpec addPairsFrom:#( #pickColor 'Pick a Color from the Screen' ) ! helpSpec "This resource specification was automatically generated by the UIHelpTool of ST/X." "Do not manually edit this!! If it is corrupted, the UIHelpTool may not be able to read the specification." " UIHelpTool openOnClass:ColorEditDialog " <resource: #help> ^ super helpSpec addPairsFrom:#( #brightness 'The Color''s brightness value (0..1)' #colorDefinitionString 'A Smalltalk expression to construct the color' #colorName 'The standard colorname (as used in the X-Window System), if known' #copyToClipboard 'Copy the color to the clipboard' #hlsMixer 'Mix color from hls (hue-light-saturation) components' #htmlColorName 'The color as used in an HTML page' #pasteFromClipboard 'Paste color from the Clipboard' #rgbMixer 'Mix color from rgb (red-green-blue) components' ) "Modified: / 09-08-2012 / 09:35:29 / cg" ! ! !ColorEditDialog class methodsFor:'image specs'! pickColorIcon ^ ToolbarIconLibrary pipette16x16Icon ! ! !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:ColorEditDialog andSelector:#windowSpec ColorEditDialog new openInterface:#windowSpec ColorEditDialog open " <resource: #canvas> ^ #(FullSpec name: windowSpec window: (WindowSpec label: 'Define Color' name: 'Define Color' min: (Point 440 360) max: (Point 440 360) bounds: (Rectangle 0 0 440 360) ) component: (SpecCollection collection: ( (VerticalPanelViewSpec name: 'RGBLabelPanel' layout: (LayoutFrame 0 0 0 0 70 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 70 0 0 0 -177 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 193 16) ) (SliderSpec name: 'GreenSlider' tabable: false model: green orientation: horizontal stop: 255 step: 1 backgroundColor: (Color 0.0 100.0 0.0) extent: (Point 193 16) ) (SliderSpec name: 'BlueSlider' tabable: false model: blue orientation: horizontal stop: 255 step: 1 backgroundColor: (Color 0.0 0.0 100.0) extent: (Point 193 16) ) ) ) ) (VerticalPanelViewSpec name: 'RGBFieldPanel' layout: (LayoutFrame -173 1 0 0 -143 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 28 20) ) (InputFieldSpec name: 'GreenField' model: green type: numberInRange numChars: 3 minValue: 0 maxValue: 255 acceptOnPointerLeave: false extent: (Point 28 20) ) (InputFieldSpec name: 'BlueField' model: blue type: numberInRange numChars: 3 minValue: 0 maxValue: 255 acceptOnPointerLeave: false extent: (Point 28 20) ) ) ) ) (VerticalPanelViewSpec name: 'RGBFieldPanelHex' layout: (LayoutFrame -141 1 0 0 -119 1 76 0) horizontalLayout: fit verticalLayout: spreadSpace horizontalSpace: 3 verticalSpace: 3 component: (SpecCollection collection: ( (InputFieldSpec name: 'EntryField4' model: red type: hexIntegerInRange numChars: 3 minValue: 0 maxValue: 255 acceptOnPointerLeave: false extent: (Point 20 20) ) (InputFieldSpec name: 'EntryField5' model: green type: hexIntegerInRange numChars: 3 minValue: 0 maxValue: 255 acceptOnPointerLeave: false extent: (Point 20 20) ) (InputFieldSpec name: 'EntryField6' model: blue type: hexIntegerInRange numChars: 3 minValue: 0 maxValue: 255 acceptOnPointerLeave: false extent: (Point 20 20) ) ) ) ) (VerticalPanelViewSpec name: 'HLSLabelPanel' layout: (LayoutFrame 0 0 86 0 70 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: 'Saturation:' name: 'Label3' translateLabel: true adjust: right useDefaultExtent: true ) ) ) ) (VerticalPanelViewSpec name: 'HLSSliderPanel' layout: (LayoutFrame 70 0 86 0 -177 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 193 16) ) (SliderSpec name: 'Slider2' tabable: false model: light orientation: horizontal step: 1 backgroundColor: (Color 66.9993133440146 66.9993133440146 66.9993133440146) keyboardStep: 1 extent: (Point 193 16) ) (SliderSpec name: 'Slider3' tabable: false model: saturation orientation: horizontal step: 1 backgroundColor: (Color 66.9993133440146 66.9993133440146 66.9993133440146) keyboardStep: 1 extent: (Point 193 16) ) ) ) ) (VerticalPanelViewSpec name: 'HLSFieldPanel' layout: (LayoutFrame -173 1 86 0 -143 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 28 20) ) (InputFieldSpec name: 'EntryField2' model: light type: numberInRange numChars: 3 minValue: 0 maxValue: 100 acceptOnPointerLeave: false extent: (Point 28 20) ) (InputFieldSpec name: 'EntryField3' model: saturation type: numberInRange numChars: 3 minValue: 0 maxValue: 100 acceptOnPointerLeave: false extent: (Point 28 20) ) ) ) ) (ViewSpec name: 'PreviewBoxFrame' 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 postBuildCallback: postBuildPreviewBox: ) ) ) ) (LabelSpec label: 'Brightness:' name: 'Label5' layout: (LayoutFrame 0 0 175 0 70 0 197 0) activeHelpKey: brightness translateLabel: true adjust: right ) (InputFieldSpec name: 'EntryField8' layout: (LayoutFrame 71 0 175 0 -296 1 197 0) activeHelpKey: brightness model: brightnessStringHolder isReadOnly: true immediateAccept: false acceptOnReturn: true acceptOnTab: true acceptOnLostFocus: true acceptOnPointerLeave: true ) (LabelSpec label: 'Color Name:' name: 'ColorNameLabel' layout: (LayoutFrame 2 0 214 0 115 0 236 0) activeHelpKey: colorName translateLabel: true adjust: right ) (InputFieldSpec name: 'ColorNameField' layout: (LayoutFrame 117 0 214 0 -122 1 236 0) activeHelpKey: colorName model: colorNameHolder immediateAccept: false acceptOnReturn: true acceptOnTab: true acceptOnLostFocus: true acceptOnPointerLeave: true ) (LabelSpec label: 'HTML Color Name:' name: 'HTMLColorNameLabel' layout: (LayoutFrame 2 0 240 0 115 0 262 0) activeHelpKey: htmlColorName translateLabel: true adjust: right ) (InputFieldSpec name: 'MLHTColorNameFieldField' layout: (LayoutFrame 117 0 240 0 -122 1 262 0) activeHelpKey: htmlColorName model: htmlColorNameHolder immediateAccept: false acceptOnReturn: true acceptOnTab: true acceptOnLostFocus: true acceptOnPointerLeave: true ) (LabelSpec label: 'Color Definition:' name: 'Label4' layout: (LayoutFrame 2 0 266 0 115 0 288 0) activeHelpKey: colorDefinitionString translateLabel: true adjust: right ) (InputFieldSpec name: 'EntryField7' layout: (LayoutFrame 117 0 266 0 -122 1 288 0) activeHelpKey: colorDefinitionString model: colorDefinitionStringHolder isReadOnly: true immediateAccept: false acceptOnReturn: true acceptOnTab: true acceptOnLostFocus: true acceptOnPointerLeave: true ) (ActionButtonSpec label: 'Copy Color' name: 'CopyColor' layout: (LayoutFrame 12 0 298 0 100 0 320 0) activeHelpKey: hlsMixer translateLabel: true resizeForLabel: true tabable: true model: copyColor ) (ActionButtonSpec label: 'Paste Color' name: 'PasteColor' layout: (LayoutFrame 108 0 298 0 196 0 320 0) translateLabel: true resizeForLabel: true tabable: true model: pasteColor ) (ActionButtonSpec label: 'pickColorIcon' name: 'Button1' layout: (LayoutFrame 285 0 298 0 312 0 325 0) activeHelpKey: pickColor hasCharacterOrientedLabel: false translateLabel: true resizeForLabel: true tabable: true model: pickColor ) (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 class methodsFor:'startup'! openOn:aColor ^ self new color:aColor; open; yourself " self openOn:Color red " ! ! !ColorEditDialog methodsFor:'accessing'! color |colorName| colorName := self colorName. colorName notEmptyOrNil ifTrue:[ ^ Color name:(colorName asSymbol) ]. ^ Color redByte:(red value) greenByte:(green value) blueByte:(blue value) ! color:aColor aColor isNil ifTrue:[ ^ self ]. aColor isSymbol ifTrue:[ self colorNameHolder value:aColor ] ifFalse:[ self red value:aColor redByte. self green value:aColor greenByte. self blue value:aColor blueByte. ] ! colorName ^ colorNameHolder value ! colorNameOrColor |colorName| colorName := self colorName. colorName notEmptyOrNil ifTrue:[ "/ ^ Color name:(colorName asSymbol) ^ colorName asSymbol ]. ^ Color redByte:(red value) greenByte:(green value) blueByte:(blue value) ! htmlColorName ^ htmlColorNameHolder value ! ! !ColorEditDialog methodsFor:'actions'! colorChanged |clr nm| clr := self colorNameOrColor. clr isColor ifTrue:[ "not a symbol" self setPreview:clr. self htmlColorNameHolder value:(clr htmlPrintString) withoutNotifying:self. nm := #(white red green blue black) detect:[:nm | clr = (Color perform:nm)] ifNone:nil. nm notNil ifTrue:[ self colorDefinitionStringHolder value:('Color ',nm). ] ifFalse:[ self colorDefinitionStringHolder value:('Color rgbValue:16r',(clr rgbValue hexPrintString leftPaddedTo:6 with:$0)). ]. self brightnessStringHolder value:((clr brightness asFixedPoint:3) printString). ]. "Modified: / 27-01-2011 / 12:54:04 / cg" ! colorChangedTo:clr "compute rgb and hls (if possible)" |h| self red value:clr redByte withoutNotifying:self. self green value:clr greenByte withoutNotifying:self. self blue value:clr blueByte withoutNotifying:self. h := clr hue. h notNil ifTrue:[ self hue value:(h rounded) withoutNotifying:self. ]. self light value:(clr light rounded) withoutNotifying:self. self saturation value:(clr saturation rounded) withoutNotifying:self. self colorChanged "Modified: / 27-01-2011 / 12:48:28 / cg" ! colorNameChanged "compute rgb and hls (if possible)" |clr| clr := Color name:colorNameHolder value ifIllegal:nil. clr isNil ifTrue:[ ^ self ]. self colorChangedTo:clr. ! copyColor self window setClipboardObject:self color ! copyColorName self window setClipboardText:self htmlColorName ! 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 ! htmlColorNameChanged "compute rgb and hls (if possible)" |clr| htmlColorNameHolder value isEmptyOrNil ifTrue:[ ^ self. ]. clr := Color rgbValue:(Integer readFrom:(htmlColorNameHolder value copyFrom:2) radix:16 onError:nil). clr isNil ifTrue:[ ^ self ]. self colorNameHolder value:'' withoutNotifying:self. self colorChangedTo:clr. ! pasteColor |copyBufferColor| copyBufferColor := self window getClipboardObject. copyBufferColor isColor ifFalse:[ UserPreferences current beepInEditor ifTrue:[ self window beep. ]. ^ self ]. self color:copyBufferColor ! pickColor |color| color := Color fromUserWithFeedBack:[:clr | self setPreview:clr]. color notNil ifTrue:[ self color:color. ] ! 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 ! setPreview:color previewBox isNil ifTrue:[^ self "called before setup"]. previewBox backgroundColor:color. previewBox foregroundColor:(color brightness < 0.5 ifTrue:[Color white] ifFalse:[Color black]). ! ! !ColorEditDialog methodsFor:'aspects'! blue blue isNil ifTrue:[ blue := 0 asValue. blue addDependent:self. ]. ^blue ! brightnessStringHolder brightnessStringHolder isNil ifTrue:[ brightnessStringHolder := 0 asValue. "/ brightness addDependent:self. ]. ^ brightnessStringHolder "Created: / 27-01-2011 / 12:48:00 / cg" ! colorDefinitionStringHolder colorDefinitionStringHolder isNil ifTrue:[ colorDefinitionStringHolder := '' asValue. "/ colorDefinitionStringHolder addDependent:self. ]. ^colorDefinitionStringHolder "Created: / 27-01-2011 / 12:38:12 / cg" ! colorNameHolder colorNameHolder isNil ifTrue:[ colorNameHolder := '' asValue. colorNameHolder addDependent:self. ]. ^colorNameHolder ! green green isNil ifTrue:[ green := 0 asValue. green addDependent:self. ]. ^green ! htmlColorNameHolder htmlColorNameHolder isNil ifTrue:[ htmlColorNameHolder := '' asValue. htmlColorNameHolder addDependent:self. ]. ^htmlColorNameHolder ! 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. ^ self ]. (changedObject == hue or:[changedObject == light or:[changedObject == saturation]]) ifTrue:[ self hlsSliderChanged. ^ self ]. (changedObject == colorNameHolder) ifTrue:[ self colorNameChanged. ^ self ]. (changedObject == htmlColorNameHolder) ifTrue:[ self htmlColorNameChanged. ^ self ]. super update:something with:aParameter from:changedObject ! ! !ColorEditDialog methodsFor:'startup & release'! postBuildPreviewBox:aView previewBox := aView ! postBuildWith:aBuilder super postBuildWith:aBuilder. self colorChanged. "Modified: / 6.9.1998 / 22:55:25 / cg" ! ! !ColorEditDialog class methodsFor:'documentation'! version ^ '$Header$' ! version_CVS ^ '$Header$' ! !