Category : Miscellaneous Language Source Code
Archive   : STCODE.ZIP
Filename : VISPROGR.ST
AUTHOR Norbert Fortelny
FUNCTION Feedback for long actions as progressing slider.
ST-VERSIONS Visualworks ST R4.1
PREREQUISITES none
CONFLICTS
DISTRIBUTION world
VERSION 1
SUMMARY
Allows to open a dialog window with a slider that gives a feedback
while longer actions are executing.
Tested on SUN sparc.
Norbert FORTELNY email: [email protected]"
'From VisualWorks(TM), Release 1.0 of 8 October 1992 on 6 April 1993 at 5:15:57 pm'!
UIBuilder subclass: #VisualProgressUIBuilder
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'NMIS-Visual'!
!VisualProgressUIBuilder methodsFor: 'scheduling'!
openWithExtent: aPoint
"Open the builder's window with type #normal at aPoint"
self openWithExtent: aPoint andType: #dialog! !
ApplicationModel subclass: #VisualProgress
instanceVariableNames: 'progress start stop '
classVariableNames: ''
poolDictionaries: ''
category: 'NMIS-Visual'!
VisualProgress comment:
'My instances present a dialog window with a slider while a longer action is in progress.
A special UIBuilder is needed, because i need a normal window in a dialog look.
See "VisualProgress example"'!
!VisualProgress methodsFor: 'aspects'!
progress
"This method was generated by UIDefiner. The initialization provided
below may have been preempted by an initialize method."
^progress isNil ifTrue: [progress := 0 asValue] ifFalse: [progress]! !
!VisualProgress methodsFor: 'accessing'!
start: aStart stop: aStop
progress := aStart asValue.
start := aStart.
stop := aStop! !
!VisualProgress methodsFor: 'actions'!
close
"This stub method was generated by UIDefiner"
^self closeRequest!
progress: aNumber
"after changing the sliders position, we update the view"
progress value: aNumber.
self builder window checkForEvents! !
!VisualProgress methodsFor: 'interface opening'!
openInterface: aSymbol
"have to reimplement to change to my VisualProgressUIBuilder, that opens the window as a
dialog box"
| spec |
builder := VisualProgressUIBuilder new.
builder source: self.
spec := self class interfaceSpecFor: aSymbol.
self preBuildWith: builder.
builder add: spec.
self postBuildWith: builder.
builder window model: self.
builder openWithExtent: spec window bounds extent.
self postOpenWith: builder.
^builder!
postBuildWith: aBuilder
"transfer the range to the range model"
| rangeModel |
super postBuildWith: aBuilder.
rangeModel := (aBuilder componentAt: #progressSlider) widget model.
rangeModel rangeStart: start.
rangeModel rangeStop: stop! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
VisualProgress class
instanceVariableNames: ''!
!VisualProgress class methodsFor: 'interface specs'!
windowSpec
"UIPainter new openOnClass: self andSelector: #windowSpec"
^#(#FullSpec #window: #(#WindowSpec #label: 'Progress indicator' #min: #(#Point 50 50 ) #bounds: #(#Rectangle 83 788 390 850 ) ) #component: #(#SpecCollection #collection: #(#(#SliderSpec #layout: #(#LayoutFrame 10 0 35 0 -10 1 -10 1 ) #name: #progressSlider #model: #progress #orientation: #horizontal #start: 0 #stop: 100 #step: 1 ) #(#LabelSpec #layout: #(#Point 10 5 ) #name: #progressLabel #label: 'Progress' ) ) ) )! !
!VisualProgress class methodsFor: 'example'!
example
"VisualProgress example"
| start stop aVisualProgress |
start := 1.
stop := 50.
aVisualProgress := VisualProgress start: start stop: stop.
start to: stop do: [:j | aVisualProgress progress: j].
aVisualProgress close! !
!VisualProgress class methodsFor: 'interface opening'!
start: aStart stop: aStop
| aVisualProgress |
aVisualProgress := self new start: aStart s self openOn: aVisualProgress.
^aVisualProgress! !
VisualProgress example!
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/