开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
scrollbar.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：24k
源码类别：

通讯编程

开发平台：

Visual C++

scrollbar.test：源码内容
  1. # This file is a Tcl script to test out scrollbar widgets and
  2. # the "scrollbar" command of Tk.  It is organized in the standard
  3. # fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1994 The Regents of the University of California.
  6. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  7. # Copyright (c) 1998-1999 by Scriptics Corporation.
  8. # All rights reserved.
  9. #
  10. # RCS: @(#) $Id: scrollbar.test,v 1.9.2.2 2006/03/14 06:03:57 dgp Exp $
  12. package require tcltest 2.1
  13. namespace import -force tcltest::configure
  14. namespace import -force tcltest::testsDirectory
  15. configure -testdir [file join [pwd] [file dirname [info script]]]
  16. configure -loadfile [file join [testsDirectory] constraints.tcl]
  17. tcltest::loadTestedCommands
  19. ## testmetrics is a win/mac only test command
  20. ##
  21. testConstraint testmetrics [llength [info commands testmetrics]]
  23. update
  25. proc scroll args {
  26.     global scrollInfo
  27.     set scrollInfo $args
  28. }
  30. proc getTroughSize {w} {
  31.     if {[testConstraint testmetrics]} {
  32. if [string match v* [$w cget -orient]] {
  33.     return [expr [winfo height $w] - 2*[testmetrics cyvscroll $w]]
  34. } else {
  35.     return [expr [winfo width $w] - 2*[testmetrics cxhscroll $w]]
  36. }     
  37.     } else {
  38. if [string match v* [$w cget -orient]] {
  39.     return [expr [winfo height $w] 
  40.     - ([winfo width $w] 
  41. - [$w cget -highlightthickness] 
  42. - [$w cget -bd] + 1)*2]
  43. } else {
  44.     return [expr [winfo width $w] 
  45.     - ([winfo height $w] 
  46. - [$w cget -highlightthickness] 
  47. - [$w cget -bd] + 1)*2]
  48. }
  49.     }
  50. }
  52. # XXX Note: this test file is woefully incomplete.  Right now there are
  53. # only bits and pieces of tests.  Please make this file more complete
  54. # as you fix bugs and add features.
  56. foreach {width height} [wm minsize .] {
  57.     set height [expr ($height < 200) ? 200 : $height]
  58.     set width [expr ($width < 1) ? 1 : $width]
  59. } 
  61. frame .f -height $height -width $width
  62. pack .f -side left
  63. scrollbar .s
  64. pack .s -side right -fill y
  65. update
  66. set i 1
  67. foreach test {
  68.     {-activebackground #ff0000 #ff0000 non-existent
  69.     {unknown color name "non-existent"}}
  70.     {-activerelief sunken sunken non-existent
  71.     {bad relief type "non-existent": must be flat, groove, raised, ridge, solid, or sunken}}
  72.     {-background #ff0000 #ff0000 non-existent
  73.     {unknown color name "non-existent"}}
  74.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  75.     {-bg #ff0000 #ff0000 non-existent
  76.     {unknown color name "non-existent"}}
  77.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  78.     {-command "set x" {set x} {} {}}
  79.     {-elementborderwidth 4 4 badValue {bad screen distance "badValue"}}
  80.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  81.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  82.     {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
  83.     {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
  84.     {-highlightthickness -2 0 {} {}}
  85.     {-jump true 1 silly {expected boolean value but got "silly"}}
  86.     {-orient horizontal horizontal badValue
  87.     {bad orientation "badValue": must be vertical or horizontal}}
  88.     {-orient horizontal horizontal bogus {bad orientation "bogus": must be vertical or horizontal}}
  89.     {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
  90.     {-repeatdelay 140 140 129.3 {expected integer but got "129.3"}}
  91.     {-repeatinterval 140 140 129.3 {expected integer but got "129.3"}}
  92.     {-takefocus "any string" "any string" {} {}}
  93.     {-troughcolor #432 #432 lousy {unknown color name "lousy"}}
  94.     {-width 32 32 badValue {bad screen distance "badValue"}}
  95. } {
  96.     set name [lindex $test 0]
  97.     test scrollbar-1.1 {configuration options} {
  98. .s configure $name [lindex $test 1]
  99. lindex [.s configure $name] 4
  100.     } [lindex $test 2]
  101.     incr i
  102.     if {[lindex $test 3] != ""} {
  103. test scrollbar-1.2 {configuration options} {
  104.     list [catch {.s configure $name [lindex $test 3]} msg] $msg
  105. } [list 1 [lindex $test 4]]
  106.     }
  107.     .s configure $name [lindex [.s configure $name] 3]
  108.     incr i
  109. }
  111. destroy .s
  112. test scrollbar-2.1 {Tk_ScrollbarCmd procedure} {
  113.     list [catch {scrollbar} msg] $msg
  114. } {1 {wrong # args: should be "scrollbar pathName ?options?"}}
  115. test scrollbar-2.2 {Tk_ScrollbarCmd procedure} {
  116.     list [catch {scrollbar gorp} msg] $msg
  117. } {1 {bad window path name "gorp"}}
  118. test scrollbar-2.3 {Tk_ScrollbarCmd procedure} {
  119.     scrollbar .s
  120.     set x "[winfo class .s] [info command .s]"
  121.     destroy .s
  122.     set x
  123. } {Scrollbar .s}
  124. test scrollbar-2.4 {Tk_ScrollbarCmd procedure} {
  125.     list [catch {scrollbar .s -gorp blah} msg] $msg [winfo exists .s] 
  126.     [info command .s]
  127. } {1 {unknown option "-gorp"} 0 {}}
  128. test scrollbar-2.5 {Tk_ScrollbarCmd procedure} {
  129.     set x [scrollbar .s]
  130.     destroy .s
  131.     set x
  132. } {.s}
  134. scrollbar .s -orient vertical -command scroll -highlightthickness 2 -bd 2
  135. pack .s -side right -fill y
  136. update
  137. test scrollbar-3.1 {ScrollbarWidgetCmd procedure} {
  138.     list [catch {.s} msg] $msg
  139. } {1 {wrong # args: should be ".s option ?arg arg ...?"}}
  140. test scrollbar-3.2 {ScrollbarWidgetCmd procedure, "cget" option} {
  141.     list [catch {.s cget} msg] $msg
  142. } {1 {wrong # args: should be ".s cget option"}}
  143. test scrollbar-3.3 {ScrollbarWidgetCmd procedure, "cget" option} {
  144.     list [catch {.s cget -gorp} msg] $msg
  145. } {1 {unknown option "-gorp"}}
  146. test scrollbar-3.4 {ScrollbarWidgetCmd procedure, "activate" option} {
  147.     list [catch {.s activate a b} msg] $msg
  148. } {1 {wrong # args: should be ".s activate element"}}
  149. test scrollbar-3.5 {ScrollbarWidgetCmd procedure, "activate" option} {
  150.     .s activate arrow1
  151.     .s activate
  152. } {arrow1}
  153. test scrollbar-3.6 {ScrollbarWidgetCmd procedure, "activate" option} {
  154.     .s activate slider
  155.     .s activate
  156. } {slider}
  157. test scrollbar-3.7 {ScrollbarWidgetCmd procedure, "activate" option} {
  158.     .s activate arrow2
  159.     .s activate
  160. } {arrow2}
  161. test scrollbar-3.8 {ScrollbarWidgetCmd procedure, "activate" option} {
  162.     .s activate s
  163.     .s activate {}
  164.     .s activate
  165. } {}
  166. test scrollbar-3.9 {ScrollbarWidgetCmd procedure, "activate" option} {
  167.     list [catch {.s activate trough1} msg] $msg
  168. } {0 {}}
  169. test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} {
  170.     list [catch {.s cget -orient} msg] $msg
  171. } {0 vertical}
  172. scrollbar .s2
  173. test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
  174.     list [catch {.s2 cget -bd} msg] $msg
  175. } {0 0}
  176. test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
  177.     list [catch {.s2 cget -bd} msg] $msg
  178. } {0 2}
  179. test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
  180.     list [catch {.s2 cget -highlightthickness} msg] $msg
  181. } {0 0}
  182. test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
  183.     list [catch {.s2 cget -highlightthickness} msg] $msg
  184. } {0 1}
  185. destroy .s2
  186. test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} {
  187.     llength [.s configure]
  188. } {20}
  189. test scrollbar-3.16 {ScrollbarWidgetCmd procedure, "configure" option} {
  190.     list [catch {.s configure -bad} msg] $msg
  191. } {1 {unknown option "-bad"}}
  192. test scrollbar-3.17 {ScrollbarWidgetCmd procedure, "configure" option} {
  193.     .s configure -orient
  194. } {-orient orient Orient vertical vertical}
  195. test scrollbar-3.18 {ScrollbarWidgetCmd procedure, "configure" option} {
  196.     .s configure -orient horizontal
  197.     set x [.s cget -orient]
  198.     .s configure -orient vertical
  199.     set x
  200. } {horizontal}
  201. test scrollbar-3.19 {ScrollbarWidgetCmd procedure, "configure" option} {
  202.     list [catch {.s configure -bad worse} msg] $msg
  203. } {1 {unknown option "-bad"}}
  204. test scrollbar-3.20 {ScrollbarWidgetCmd procedure, "delta" option} {
  205.     list [catch {.s delta 24} msg] $msg
  206. } {1 {wrong # args: should be ".s delta xDelta yDelta"}}
  207. test scrollbar-3.21 {ScrollbarWidgetCmd procedure, "delta" option} {
  208.     list [catch {.s delta 24 35 42} msg] $msg
  209. } {1 {wrong # args: should be ".s delta xDelta yDelta"}}
  210. test scrollbar-3.22 {ScrollbarWidgetCmd procedure, "delta" option} {
  211.     list [catch {.s delta silly 24} msg] $msg
  212. } {1 {expected integer but got "silly"}}
  213. test scrollbar-3.23 {ScrollbarWidgetCmd procedure, "delta" option} {
  214.     list [catch {.s delta 18 xxyz} msg] $msg
  215. } {1 {expected integer but got "xxyz"}}
  216. test scrollbar-3.24 {ScrollbarWidgetCmd procedure, "delta" option} {
  217.     list [catch {.s delta 18 xxyz} msg] $msg
  218. } {1 {expected integer but got "xxyz"}}
  219. test scrollbar-3.25 {ScrollbarWidgetCmd procedure, "delta" option} {
  220.     .s delta 20 0
  221. } {0}
  222. test scrollbar-3.26 {ScrollbarWidgetCmd procedure, "delta" option} {
  223.     .s delta 0 20
  224. } [format %.6g [expr 20.0/([getTroughSize .s]-1)]]
  225. test scrollbar-3.27 {ScrollbarWidgetCmd procedure, "delta" option} {
  226.     .s delta 0 -20
  227. } [format %.6g [expr -20.0/([getTroughSize .s]-1)]]
  228. test scrollbar-3.28 {ScrollbarWidgetCmd procedure, "delta" option} {
  229.     toplevel .t -width 250 -height 100
  230.     wm geom .t +0+0
  231.     scrollbar .t.s -orient horizontal -borderwidth 2
  232.     place .t.s -width 201
  233.     update
  234.     set result [list [.t.s delta 0 20] 
  235.     [.t.s delta [expr [getTroughSize .t.s] - 1] 0]]
  236.     destroy .t
  237.     set result
  238. } {0 1}
  239. test scrollbar-3.29 {ScrollbarWidgetCmd procedure, "fraction" option} {
  240.     list [catch {.s fraction 24} msg] $msg
  241. } {1 {wrong # args: should be ".s fraction x y"}}
  242. test scrollbar-3.30 {ScrollbarWidgetCmd procedure, "fraction" option} {
  243.     list [catch {.s fraction 24 30 32} msg] $msg
  244. } {1 {wrong # args: should be ".s fraction x y"}}
  245. test scrollbar-3.31 {ScrollbarWidgetCmd procedure, "fraction" option} {
  246.     list [catch {.s fraction silly 24} msg] $msg
  247. } {1 {expected integer but got "silly"}}
  248. test scrollbar-3.32 {ScrollbarWidgetCmd procedure, "fraction" option} {
  249.     list [catch {.s fraction 24 bogus} msg] $msg
  250. } {1 {expected integer but got "bogus"}}
  251. test scrollbar-3.33 {ScrollbarWidgetCmd procedure, "fraction" option} {
  252.     .s fraction 0 0
  253. } {0}
  254. test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} {
  255.     .s fraction 0 1000
  256. } {1}
  257. test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} {
  258.     .s fraction 4 21
  259. } [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) 
  260.        /([getTroughSize .s] - 1)]]
  261. test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} {
  262.     .s fraction 4 179
  263. } {1}
  264. test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} {
  265.     .s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]
  266. } {1}
  267. test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} {
  268.     .s fraction 4 178
  269. } {0.993711}
  270. test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics pcOnly} {
  271.     expr [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s] - 2]] 
  272. == [format %g [expr (200.0 - [testmetrics cyvscroll .s]*2 - 2) 
  273.    / ($height - 1 - [testmetrics cyvscroll .s]*2)]]
  274. } 1
  275. test scrollbar-3.40 {ScrollbarWidgetCmd procedure, "fraction" option} {macOnly} {
  276.     .s fraction 4 178
  277. } {0.97006}
  279. toplevel .t -width 250 -height 100
  280. wm geom .t +0+0
  281. scrollbar .t.s -orient horizontal -borderwidth 2
  282. place .t.s -width 201
  283. update
  285. test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} {
  286.     .t.s fraction 100 0
  287. } {0.5}
  288. if {[testConstraint testmetrics]} {
  289.     place configure .t.s -width [expr 2*[testmetrics cxhscroll .t.s]+1]
  290. } else {
  291.     place configure .t.s -width [expr [winfo reqwidth .t.s] - 4]
  292. }
  293. update
  294. test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} {
  295.     .t.s fraction 100 0
  296. } {0}
  297. destroy .t
  298. test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} {
  299.     list [catch {.s get a} msg] $msg
  300. } {1 {wrong # args: should be ".s get"}}
  301. test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} {
  302.     .s set 100 10 13 14
  303.     .s get
  304. } {100 10 13 14}
  305. test scrollbar-3.45 {ScrollbarWidgetCmd procedure, "get" option} {
  306.     .s set 0.6 0.8
  307.     set result {}
  308.     foreach element [.s get] {
  309. lappend result [format %.1f $element]
  310.     }
  311.     set result
  312. } {0.6 0.8}
  313. test scrollbar-3.46 {ScrollbarWidgetCmd procedure, "identify" option} {
  314.     list [catch {.s identify 0} msg] $msg
  315. } {1 {wrong # args: should be ".s identify x y"}}
  316. test scrollbar-3.47 {ScrollbarWidgetCmd procedure, "identify" option} {
  317.     list [catch {.s identify 0 0 1} msg] $msg
  318. } {1 {wrong # args: should be ".s identify x y"}}
  319. test scrollbar-3.48 {ScrollbarWidgetCmd procedure, "identify" option} {
  320.     list [catch {.s identify bogus 2} msg] $msg
  321. } {1 {expected integer but got "bogus"}}
  322. test scrollbar-3.49 {ScrollbarWidgetCmd procedure, "identify" option} {
  323.     list [catch {.s identify -1 bogus} msg] $msg
  324. } {1 {expected integer but got "bogus"}}
  325. test scrollbar-3.50 {ScrollbarWidgetCmd procedure, "identify" option} {
  326.     .s identify 5 5
  327. } {arrow1}
  328. test scrollbar-3.51 {ScrollbarWidgetCmd procedure, "identify" option} {
  329.     .s identify 5 35
  330. } {trough1}
  331. test scrollbar-3.52 {ScrollbarWidgetCmd procedure, "identify" option} {
  332.     .s set .3 .6
  333.     .s identify 5 80
  334. } {slider}
  335. test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} {
  336.     .s identify 5 145
  337. } {trough2}
  338. test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} {
  339.     .s identify 5 195
  340. } {arrow2}
  341. test scrollbar-3.55 {ScrollbarWidgetCmd procedure, "identify" option} {macOnly} {
  342.     .s identify 5 195
  343. } {}
  344. test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} {unixOnly} {
  345.     .s identify 0 0
  346. } {}
  347. test scrollbar-3.57 {ScrollbarWidgetCmd procedure, "set" option} {
  348.     list [catch {.s set abc def} msg] $msg
  349. } {1 {expected floating-point number but got "abc"}}
  350. test scrollbar-3.58 {ScrollbarWidgetCmd procedure, "set" option} {
  351.     list [catch {.s set 0.6 def} msg] $msg
  352. } {1 {expected floating-point number but got "def"}}
  353. test scrollbar-3.59 {ScrollbarWidgetCmd procedure, "set" option} {
  354.     .s set -.2 .3
  355.     set result {}
  356.     foreach element [.s get] {
  357. lappend result [format %.1f $element]
  358.     }
  359.     set result
  360. } {0.0 0.3}
  361. test scrollbar-3.60 {ScrollbarWidgetCmd procedure, "set" option} {
  362.     .s set 1.1 .4 
  363.     .s get
  364. } {1.0 1.0}
  365. test scrollbar-3.61 {ScrollbarWidgetCmd procedure, "set" option} {
  366.     .s set .5 -.3 
  367.     .s get
  368. } {0.5 0.5}
  369. test scrollbar-3.62 {ScrollbarWidgetCmd procedure, "set" option} {
  370.     .s set .5 87 
  371.     .s get
  372. } {0.5 1.0}
  373. test scrollbar-3.63 {ScrollbarWidgetCmd procedure, "set" option} {
  374.     .s set .4 .3
  375.     set result {}
  376.     foreach element [.s get] {
  377. lappend result [format %.1f $element]
  378.     }
  379.     set result
  380. } {0.4 0.4}
  381. test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} {
  382.     list [catch {.s set abc def ghi jkl} msg] $msg
  383. } {1 {expected integer but got "abc"}}
  384. test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} {
  385.     list [catch {.s set 1 def ghi jkl} msg] $msg
  386. } {1 {expected integer but got "def"}}
  387. test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} {
  388.     list [catch {.s set 1 2 ghi jkl} msg] $msg
  389. } {1 {expected integer but got "ghi"}}
  390. test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} {
  391.     list [catch {.s set 1 2 3 jkl} msg] $msg
  392. } {1 {expected integer but got "jkl"}}
  393. test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} {
  394.     .s set -10 50 20 30 
  395.     .s get
  396. } {0 50 0 0}
  397. test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} {
  398.     .s set 100 -10 20 30 
  399.     .s get
  400. } {100 0 20 30}
  401. test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} {
  402.     .s set 100 50 30 20 
  403.     .s get
  404. } {100 50 30 30}
  405. test scrollbar-3.71 {ScrollbarWidgetCmd procedure, "set" option} {
  406.     list [catch {.s set 1 2 3} msg] $msg
  407. } {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}}
  408. test scrollbar-3.72 {ScrollbarWidgetCmd procedure, "set" option} {
  409.     list [catch {.s set 1 2 3 4 5} msg] $msg
  410. } {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}}
  411. test scrollbar-3.73 {ScrollbarWidgetCmd procedure} {
  412.     list [catch {.s bogus} msg] $msg
  413. } {1 {bad option "bogus": must be activate, cget, configure, delta, fraction, get, identify, or set}}
  414. test scrollbar-3.74 {ScrollbarWidgetCmd procedure} {
  415.     list [catch {.s c} msg] $msg
  416. } {1 {bad option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}}
  418. test scrollbar-4.1 {ScrollbarEventProc procedure} {
  419.     catch {destroy .s1}
  420.     scrollbar .s1 -bg #543210
  421.     rename .s1 .s2
  422.     set x {}
  423.     lappend x [winfo exists .s1]
  424.     lappend x [.s2 cget -bg]
  425.     destroy .s1
  426.     lappend x [info command .s?] [winfo exists .s1] [winfo exists .s2]
  427. } {1 #543210 {} 0 0}
  429. test scrollbar-5.1 {ScrollbarCmdDeletedProc procedure} {
  430.     catch {destroy .s1}
  431.     scrollbar .s1
  432.     rename .s1 {}
  433.     list [info command .s?] [winfo exists .s1]
  434. } {{} 0}
  436. catch {destroy .s}
  437. scrollbar .s -orient vertical -relief sunken -bd 2 -highlightthickness 2
  438. pack .s -side left -fill y
  439. .s set .2 .4
  440. update
  441. test scrollbar-6.1 {ScrollbarPosition procedure} {unixOnly} {
  442.     .s identify 8 3
  443. } {}
  444. test scrollbar-6.2 {ScrollbarPosition procedure} {macOnly} {
  445.     .s identify 8 3
  446. } {arrow1}
  447. test scrollbar-6.3 {ScrollbarPosition procedure} {macOrUnix} {
  448.     .s identify 8 196
  449. } {}
  450. test scrollbar-6.4 {ScrollbarPosition procedure} {unixOnly} {
  451.     .s identify 3 100
  452. } {}
  453. test scrollbar-6.5 {ScrollbarPosition procedure} {macOnly} {
  454.     .s identify 3 100
  455. } {trough2}
  456. test scrollbar-6.6 {ScrollbarPosition procedure} {macOrUnix} {
  457.     .s identify 19 100
  458. } {}
  459. test scrollbar-6.7 {ScrollbarPosition procedure} {
  460.     .s identify [expr [winfo width .s] / 2] -1
  461. } {}
  462. test scrollbar-6.8 {ScrollbarPosition procedure} {
  463.     .s identify [expr [winfo width .s] / 2] [expr [winfo height .s]]
  464. } {}
  465. test scrollbar-6.9 {ScrollbarPosition procedure} {
  466.     .s identify -1 [expr [winfo height .s] / 2]
  467. } {}
  468. test scrollbar-6.10 {ScrollbarPosition procedure} {
  469.     .s identify [winfo width .s] [expr [winfo height .s] / 2]
  470. } {}
  472. test scrollbar-6.11 {ScrollbarPosition procedure} {macOrUnix} {
  473.     .s identify 8 4
  474. } {arrow1}
  475. test scrollbar-6.12 {ScrollbarPosition procedure} {unixOnly} {
  476.     .s identify 8 19
  477. } {arrow1}
  478. test scrollbar-6.13 {ScrollbarPosition procedure} {macOnly} {
  479.     .s identify 8 19
  480. } {trough1}
  481. test scrollbar-6.14 {ScrollbarPosition procedure} {pcOnly} {
  482.     .s identify [expr [winfo width .s] / 2] 0 
  483. } {arrow1}
  484. test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics pcOnly} {
  485.     .s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll .s] - 1]
  486. } {arrow1}
  488. test scrollbar-6.16 {ScrollbarPosition procedure} {macOrUnix} {
  489.     .s identify 8 20
  490. } {trough1}
  491. test scrollbar-6.17 {ScrollbarPosition procedure} {macOrUnix nonPortable} {
  492.     # Don't know why this is non-portable, but it doesn't work on
  493.     # some platforms.
  494.     .s identify 8 51
  495. } {trough1}
  496. test scrollbar-6.18 {ScrollbarPosition procedure} {testmetrics pcOnly} {
  497.     .s identify [expr [winfo width .s] / 2] [testmetrics cyvscroll .s]
  498. } {trough1}
  499. test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics pcOnly} {
  500.     .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) 
  501. + [testmetrics cyvscroll .s] - 1]
  502. } {trough1}
  504. test scrollbar-6.20 {ScrollbarPosition procedure} {macOrUnix} {
  505.     .s identify 8 52
  506. } {slider}
  507. test scrollbar-6.21 {ScrollbarPosition procedure} {macOrUnix nonPortable} {
  508.     # Don't know why this is non-portable, but it doesn't work on
  509.     # some platforms.
  510.     .s identify 8 83
  511. } {slider}
  512. test scrollbar-6.22 {ScrollbarPosition procedure} {testmetrics pcOnly} {
  513.     .s identify [expr [winfo width .s] / 2] 
  514. [expr int(.2 / [.s delta 0 1] + 0.5) + [testmetrics cyvscroll .s]]
  515. } {slider}
  516. test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics pcOnly} {
  517.     .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) 
  518.  + [testmetrics cyvscroll -s] - 1]
  519. } {slider}
  521. test scrollbar-6.24 {ScrollbarPosition procedure} {macOrUnix} {
  522.     .s identify 8 84
  523. } {trough2}
  524. test scrollbar-6.25 {ScrollbarPosition procedure} {unixOnly} {
  525.     .s identify 8 179
  526. } {trough2}
  527. test scrollbar-6.26 {ScrollbarPosition procedure} {macOnly} {
  528.     .s identify 8 179
  529. } {arrow2}
  530. test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics pcOnly knownBug} {
  531.     # This asks for 8,21, which is actually the slider, but there is a
  532.     # bug in that GetSystemMetrics(SM_CYVTHUMB) actually returns a value
  533.     # that is larger than the thumb displayed, skewing the ability to
  534.     # calculate the trough2 area correctly (Win2k).  -- hobbs
  535.     .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) 
  536.  + [testmetrics cyvscroll .s]]
  537. } {trough2}
  538. test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics pcOnly} {
  539.     .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] 
  540.  - [testmetrics cyvscroll .s] - 1]
  541. } {trough2}
  543. test scrollbar-6.29 {ScrollbarPosition procedure} {macOrUnix} {
  544.     .s identify 8 180
  545. } {arrow2}
  546. test scrollbar-6.30 {ScrollbarPosition procedure} {unixOnly} {
  547.     .s identify 8 195
  548. } {arrow2}
  549. test scrollbar-6.31 {ScrollbarPosition procedure} {macOnly} {
  550.     .s identify 8 195
  551. } {}
  552. test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics pcOnly} {
  553.     .s identify [expr [winfo width .s] / 2]  [expr [winfo height .s] 
  554.   - [testmetrics cyvscroll .s]]
  555. } {arrow2}
  556. test scrollbar-6.33 {ScrollbarPosition procedure} {pcOnly} {
  557.     .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1]
  558. } {arrow2}
  560. test scrollbar-6.34 {ScrollbarPosition procedure} {macOrUnix} {
  561.     .s identify 4 100
  562. } {trough2}
  563. test scrollbar-6.35 {ScrollbarPosition procedure} {unixOnly} {
  564.     .s identify 18 100
  565. } {trough2}
  566. test scrollbar-6.36 {ScrollbarPosition procedure} {macOnly} {
  567.     .s identify 18 100
  568. } {}
  569. test scrollbar-6.37 {ScrollbarPosition procedure} {pcOnly} {
  570.     .s identify 0 100
  571. } {trough2}
  572. test scrollbar-6.38 {ScrollbarPosition procedure} {pcOnly} {
  573.     .s identify [expr [winfo width .s] - 1] 100
  574. } {trough2}
  576. catch {destroy .t}
  577. toplevel .t -width 250 -height 150
  578. wm geometry .t +0+0
  579. scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2
  580. place .t.s -width 200
  581. .t.s set .2 .4
  582. update
  583. test scrollbar-6.39 {ScrollbarPosition procedure} {macOrUnix} {
  584.     .t.s identify 4 8
  585. } {arrow1}
  586. test scrollbar-6.40 {ScrollbarPosition procedure} {pcOnly} {
  587.     .t.s identify 0 [expr [winfo height .t.s] / 2]
  588. } {arrow1}
  589. test scrollbar-6.41 {ScrollbarPosition procedure} {unixOnly} {
  590.     .t.s identify 82 8
  591. } {slider}
  592. test scrollbar-6.42 {ScrollbarPosition procedure} {macOnly} {
  593.     .t.s identify 82 8
  594. } {}
  595. test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics pcOnly} {
  596.     .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s] 
  597.        - 1] [expr [winfo height .t.s] / 2] 
  598. } {slider}
  599. test scrollbar-6.44 {ScrollbarPosition procedure} {unixOnly} {
  600.     .t.s identify 100 18
  601. } {trough2}
  602. test scrollbar-6.45 {ScrollbarPosition procedure} {macOnly} {
  603.     .t.s identify 100 18
  604. } {}
  605. test scrollbar-6.46 {ScrollbarPosition procedure} {pcOnly} {
  606.     .t.s identify 100 [expr [winfo height .t.s] - 1]
  607. } {trough2}
  609. test scrollbar-7.1 {EventuallyRedraw} {
  610.     .s configure -orient horizontal
  611.     update
  612.     set result [.s cget -orient]
  613.     .s configure -orient vertical
  614.     update
  615.     lappend result [.s cget -orient]
  616. } {horizontal vertical}
  618. catch {destroy .t}
  619. toplevel .t
  620. wm geometry .t +0+0
  621. test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} {
  622.     proc doit {args} { destroy .t.f }
  623.     proc bgerror {args} {}
  624.     frame .t.f
  625.     scrollbar .t.f.s -command doit
  626.     pack .t.f -fill both -expand 1
  627.     pack .t.f.s -fill y -expand 1 -side right
  628.     wm geometry .t 100x100
  629.     .t.f.s set 0 .5
  630.     update
  631.     set result [winfo exists .t.f.s]
  632.     event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5
  633.     event generate .t <ButtonRelease> -button 1
  634.     update
  635.     lappend result [winfo exists .t.f.s] [winfo exists .t.f]
  636.     rename bgerror {}
  637.     set result
  638. } {1 0 0}
  639. test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} {
  640.     proc doit {args} { destroy .t.f.s }
  641.     proc bgerror {args} {}
  642.     frame .t.f
  643.     scrollbar .t.f.s -command doit
  644.     pack .t.f -fill both -expand 1
  645.     pack .t.f.s -fill y -expand 1 -side right
  646.     wm geometry .t 100x100
  647.     .t.f.s set 0 .5
  648.     update
  649.     set result [winfo exists .t.f.s]
  650.     event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5
  651.     event generate .t.f <ButtonRelease> -button 1
  652.     update
  653.     lappend result [winfo exists .t.f.s] [winfo exists .t.f]
  654.     rename bgerror {}
  655.     set result
  656. } {1 0 1}
  658. set l [interp hidden]
  659. deleteWindows
  661. test scrollbar-9.1 {scrollbar widget vs hidden commands} {
  662.     catch {destroy .s}
  663.     scrollbar .s
  664.     interp hide {} .s
  665.     destroy .s
  666.     list [winfo children .] [interp hidden]
  667. } [list {} $l]
  669. catch {destroy .s}
  670. catch {destroy .t}
  672. # cleanup
  673. ::tcltest::cleanupTests
  674. return