.
original commit: 35a23f954428e5e483363e3e1f3736af1fcaaad5
This commit is contained in:
parent
733908db09
commit
c4ecab7d13
|
@ -1225,6 +1225,53 @@
|
|||
(instructions p "choice-list-steps.txt")
|
||||
(send f show #t))
|
||||
|
||||
(define (slider-frame)
|
||||
(define f (make-object mred:frame% null "Slider Test"))
|
||||
(define p (make-object mred:vertical-panel% f))
|
||||
(define old-list null)
|
||||
(define commands (list wx:const-event-type-slider-command))
|
||||
(define s (make-object mred:slider% p
|
||||
(lambda (sl e)
|
||||
(unless (= (send s get-value) (send e get-selection))
|
||||
(error "slider value mismatch"))
|
||||
(check-callback-event s sl e commands #f))
|
||||
"Slide Me"
|
||||
3 -1 11 -1))
|
||||
(define c (make-object mred:button% p
|
||||
(lambda (c e)
|
||||
(for-each
|
||||
(lambda (e)
|
||||
(check-callback-event s s e commands #t))
|
||||
old-list)
|
||||
(printf "All Ok~n"))
|
||||
"Check"))
|
||||
(define (simulate v)
|
||||
(let ([e (make-object wx:command-event% wx:const-event-type-slider-command)])
|
||||
(send e set-command-int v)
|
||||
(send e set-event-object s)
|
||||
(send s command e)))
|
||||
(define p2 (make-object mred:horizontal-panel% p))
|
||||
(define p3 (make-object mred:horizontal-panel% p))
|
||||
(send p3 stretchable-in-y #f)
|
||||
(make-object mred:button% p2
|
||||
(lambda (c e)
|
||||
(send s set-value (add1 (send s get-value))))
|
||||
"Up")
|
||||
(make-object mred:button% p2
|
||||
(lambda (c e)
|
||||
(send s set-value (sub1 (send s get-value))))
|
||||
"Down")
|
||||
(make-object mred:button% p2
|
||||
(lambda (c e)
|
||||
(simulate (add1 (send s get-value))))
|
||||
"Simulate Up")
|
||||
(make-object mred:button% p2
|
||||
(lambda (c e)
|
||||
(simulate (sub1 (send s get-value))))
|
||||
"Simulate Down")
|
||||
(instructions p "slider-steps.txt")
|
||||
(send f show #t))
|
||||
|
||||
(define (gauge-frame)
|
||||
(define f (make-object mred:frame% null "Gauge Test"))
|
||||
(define p (make-object mred:vertical-panel% f))
|
||||
|
|
21
collects/tests/mred/slider-steps.txt
Normal file
21
collects/tests/mred/slider-steps.txt
Normal file
|
@ -0,0 +1,21 @@
|
|||
|
||||
The slider's initial value should be 3. The range is -1 to 11.
|
||||
|
||||
Change the slider value in each way allowed by the control (dragging,
|
||||
clicking in page-up/page-down, clicking on one-step arrows). For
|
||||
each change, the console should contain "Callback Ok". When you
|
||||
drag, one callback may be reported for the whole drag, or
|
||||
intermediate callbacks may be reported.
|
||||
|
||||
Click "Up" until the slider is at the top. Clicking when the slider
|
||||
is at its maximum value should have no effect. Click "Down" once
|
||||
aand verify that the slider is at 11.
|
||||
|
||||
Repeat the above step for "Down".
|
||||
|
||||
Repeat the above two steps for "Simulate Up" and "Simulate Down". For
|
||||
the simulates, the console should report "Callback Ok" for each click.
|
||||
If you try to go too far up or down, the console should report an
|
||||
error: "slider value mismatch".
|
||||
|
||||
Click the "Check" button. The console should report "All Ok".
|
Loading…
Reference in New Issue
Block a user