Category : OS/2 Files
Archive   : CRCLRS.ZIP
Filename : CRCLRSLD.ST

"This file contains support for Circular sliders in VOS2. Because I could not figure out
how to implement the WinRegisterCircularSlider directly from ST (it is supplied as object
in a MMPM/2 toolkit library) I had to issue it through a call to a DLL. The file MMPM2.DLL
contains one fucntion, RegisterCircularSlider which does the WinRegisterCircularSlider and
must be issued before the slider will work (although simply opening the DLL suffices, I
don't understand.

CircularSlider is an additional class subclass of ControlPane. To do this really right, an abstract
class SliderControl should be added with both Slider and CircularSlider subclassing SliderControl.
Then that which is common between these two controls could be put in the abstract class,
control pane.

The following will test the circular slider after filing-in this file

Do this and allow MMPM2Library to be a global

MMPM2Library := MMPM2 open

Then do this (again allow Cslider to be a global for testing purposes)

ApplicationWindow new
addSubpane: (Cslider := CircularSlider new
owner: self;
dialRangeFrom: 1 to: 100;
selection: 50;
dialScrollIncr: 5 tickIncr: 10;
framingRatio:
(Rectangle leftTopUnit extentFromLeftTop: 3/8 @ 1);
yourself);
open

Move the slider around and then show this

Cslider selection

"



Smalltalk at: #PMCircularSliderConstants put: ((Dictionary new)
add: (Association key: ('WcCircularSlider') value: (16rFFFF0041));
add: (Association key: ('CsmQueryRange') value: (16r053D));
add: (Association key: ('CsmSetRange') value: (16r053E));
add: (Association key: ('CsmQueryValue') value: (16r053F));
add: (Association key: ('CsmSetValue') value: (16r0540));
add: (Association key: ('CsmQueryRadius') value: (16r0541));
add: (Association key: ('CsmSetIncrement') value: (16r0542));
add: (Association key: ('CsmQueryIncrement') value: (16r0543));
add: (Association key: ('CsmSetBitmapData') value: (16r0544));
add: (Association key: ('CsnSetFocus') value: (16r0548));
add: (Association key: ('CsnChanged') value: (16r0549));
add: (Association key: ('CsnTracking') value: (16r054A));
add: (Association key: ('CsnQueryBackgroundColor') value: (16r054B));
add: (Association key: ('CssNoButton') value: (1));
add: (Association key: ('CssNoText') value: (2));
add: (Association key: ('CssNoNumber') value: (4));
add: (Association key: ('CssPointSelect') value: (8));
add: (Association key: ('Css360') value: (16));
add: (Association key: ('CssMidPoint') value: (32));
yourself)!
ControlPane subclass: #CircularSlider
instanceVariableNames:
' whenValid '
classVariableNames: ''
poolDictionaries:
' PMConstants PMCircularSliderConstants ' !


!CircularSlider class methods ! !



!CircularSlider methods !

asyncControlEvent: msg with: aParameter
"Private - Asynchronous control message handling routine."
msg = CsnChanged
ifTrue: [ self event: #select ]!

defaultStyle
"Private - Answer the default style for the
receiver."
^super defaultStyle | CssPointSelect - WsVisible!

dialRangeFrom: fromValue to: toValue

"Set the dial to start at 'fromValue' and range to 'toValue'."

handle isValid
ifTrue: [^(PMLong fromBytes: (PMWindowLibrary
sendMsg: self handle
msg: CsmSetRange
mp1: fromValue
mp2: toValue)) asBoolean]
ifFalse: [whenValid add: (Message new
receiver: self
selector: #dialRangeFrom:to:
arguments: (Array with: fromValue with: toValue))].!

dialScrollIncr: scrollIncr tickIncr: tickIncr

"Set the dial scroll increment to 'scrollIncr' and the tick increment to 'tickIncr'."

handle isValid
ifTrue: [^(PMLong fromBytes: (PMWindowLibrary
sendMsg: self handle
msg: CsmSetIncrement
mp1: scrollIncr
mp2: tickIncr)) asBoolean]
ifFalse: [whenValid add: (Message new
receiver: self
selector: #dialScrollIncr:tickIncr:
arguments: (Array with: scrollIncr with: tickIncr))].!

initialize
"Private - Initialize the receiver."
super initialize.
whenValid := OrderedCollection new.!

queryHighRange

"Answer the high range for the slider."

^self queryRange at: 2!

queryIncrement

"Answers a 2-element array with the first element
representing the scrolling increment and the second
element representing the increment for the tick marks."

| mp1 scrollIncr mp2 tickIncr |

mp1 := MemoryBlockAddress copyToNonSmalltalkMemory:
((PMLong new) asParameter).
mp2 := MemoryBlockAddress copyToNonSmalltalkMemory:
((PMLong new) asParameter).

PMWindowLibrary
sendMsg: self handle
msg: CsmQueryIncrement
mp1: mp1 asParameter
mp2: mp2 asParameter.
scrollIncr := (PMLong fromAddress: mp1) asInteger.
tickIncr := (PMLong fromAddress: mp2) asInteger.
mp1 free. mp2 free.
^Array with: scrollIncr with: tickIncr!

queryLowRange

"Answer the low range for the slider."

^self queryRange at: 1!

queryRadius

"Answer the radius of the slider."

| mp1 radius |

mp1 := MemoryBlockAddress copyToNonSmalltalkMemory:
((PMLong new) asParameter).

PMWindowLibrary
sendMsg: self handle
msg: CsmQueryRadius
mp1: mp1 asParameter
mp2: 0.
radius := (PMLong fromAddress: mp1) asInteger.
mp1 free.
^radius!

queryRange

"Answers a 2-element array with the first element
representing the low range and the second element
representing the high range for the slider.."

| mp1 lowRange mp2 highRange|

mp1 := MemoryBlockAddress copyToNonSmalltalkMemory:
((PMLong new) asParameter).
mp2 := MemoryBlockAddress copyToNonSmalltalkMemory:
((PMLong new) asParameter).

PMWindowLibrary
sendMsg: self handle
msg: CsmQueryRange
mp1: mp1 asParameter
mp2: mp2 asParameter.
lowRange := (PMLong fromAddress: mp1) asInteger.
highRange := (PMLong fromAddress: mp2) asInteger.
mp1 free. mp2 free.
^Array with: lowRange with: highRange!

queryScrollIncrement

"Answer the scrolling increment for the slider."

^self queryIncrement at: 1!

queryTickIncrement

"Answer the increment for the tick marks."

^self queryIncrement at: 2!

selection

"Answer the current value of the slider as an increment."

| mp1 |

mp1 := MemoryBlockAddress copyToNonSmalltalkMemory:
((PMLong new) asParameter).

PMWindowLibrary
sendMsg: self handle
msg: CsmQueryValue
mp1: mp1 asParameter
mp2: 0.
value := (PMLong fromAddress: mp1) asInteger.
mp1 free.
^value!

selection: anInteger

"Set the dial value to be anInteger'."

handle isValid
ifTrue: [^(PMLong fromBytes: (PMWindowLibrary
sendMsg: self handle
msg: CsmSetValue
mp1: anInteger
mp2: 0)) asBoolean]
ifFalse: [whenValid add: (Message new
receiver: self
selector: #selection:
arguments: (Array with: anInteger))].!

validate
"Private - Window was just created, set the specified options."
whenValid do: [:m | m perform].
value notNil ifTrue: [self selection: value].
super validate.!

windowClass
"Private - Answer the PM window class for the receiver."
^WcCircularSlider! !

DynamicLinkLibrary variableByteSubclass: #MMPM2
classVariableNames: ''
poolDictionaries: '' !


!MMPM2 class methods !

fileName
"Private - Answer the file name of the dll."
^'MMPM2'! !



!MMPM2 methods !

winRegisterCircularSlider

^self invalidArgument! !