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

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

通讯编程

开发平台：

Visual C++

visual_bb.test：源码内容
  1. #!/usr/local/bin/wish -f
  2. #
  3. # This script displays provides visual tests for many of Tk's features.
  4. # Each test displays a window with various information in it, along
  5. # with instructions about how the window should appear.  You can look
  6. # at the window to make sure it appears as expected.  Individual tests
  7. # are kept in separate ".tcl" files in this directory.
  8. #
  9. # RCS: @(#) $Id: visual_bb.test,v 1.7 2002/07/14 18:31:48 dgp Exp $
  11. package require tcltest 2.1
  12. namespace import -force tcltest::configure
  13. namespace import -force tcltest::testsDirectory
  14. configure -testdir [file join [pwd] [file dirname [info script]]]
  15. configure -loadfile [file join [testsDirectory] constraints.tcl]
  16. tcltest::loadTestedCommands
  18. namespace import -force tcltest::cleanupTests
  20. set auto_path ". $auto_path"
  21. wm title . "Visual Tests for Tk"
  23. set testNum 1
  25. # Each menu entry invokes a visual test file
  27. proc runTest {file} {
  28.     global testNum
  30.     test "2.$testNum" "testing $file" {userInteraction} {
  31. uplevel #0 source [file join [testsDirectory] $file]
  32. concat ""
  33.     } {}
  34.     incr testNum
  35. }
  37. # The following procedure is invoked to print the contents of a canvas:
  39. proc lpr {c args} {
  40.     exec lpr <<[eval [list $c postscript] $args]
  41. }
  43. proc end {} {
  44.     cleanupTests
  45.     set ::EndOfVisualTests 1
  46. }
  48. test 1.1 "running visual tests" {userInteraction} {
  49.     #-------------------------------------------------------
  50.     # The code below create the main window, consisting of a
  51.     # menu bar and a message explaining the basic operation
  52.     # of the program.
  53.     #-------------------------------------------------------
  55.     frame .menu -relief raised -borderwidth 1
  56.     message .msg -font {Times 18} -relief raised -width 4i 
  57.     -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the "Postscript" menu exercise the Postscript-generation capabilities of canvas widgets."
  58.     
  59.     pack .menu -side top -fill x
  60.     pack .msg -side bottom -expand yes -fill both
  62.     #-------------------------------------------------------
  63.     # The code below creates all the menus, which invoke procedures
  64.     # to create particular demonstrations of various widgets.
  65.     #-------------------------------------------------------
  67.     menubutton .menu.file -text "File" -menu .menu.file.m
  68.     menu .menu.file.m
  69.     .menu.file.m add command -label "Quit" -command end
  70.     
  71.     menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
  72.     menu .menu.group1.m
  73.     .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl}
  74.     .menu.group1.m add command -label "Beveled borders in text widgets" 
  75.     -command {runTest bevel.tcl}
  76.     .menu.group1.m add command -label "Colormap management" 
  77.     -command {runTest cmap.tcl}
  78.     .menu.group1.m add command -label "Label/button geometry" 
  79.     -command {runTest butGeom.tcl}
  80.     .menu.group1.m add command -label "Label/button colors" 
  81.     -command {runTest butGeom2.tcl}
  82.     
  83.     menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
  84.     menu .menu.ps.m
  85.     .menu.ps.m add command -label "Rectangles and other graphics" 
  86.     -command {runTest canvPsGrph.tcl}
  87.     .menu.ps.m add command -label "Text" 
  88.     -command {runTest canvPsText.tcl}
  89.     .menu.ps.m add command -label "Bitmaps" 
  90.     -command {runTest canvPsBmap.tcl}
  91.     .menu.ps.m add command -label "Images" 
  92.     -command {runTest canvPsImg.tcl}
  93.     .menu.ps.m add command -label "Arcs" 
  94.     -command {runTest canvPsArc.tcl}
  95.     
  96.     pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
  97.     
  98.     # Set up for keyboard-based menu traversal
  99.     
  100.     bind . <Any-FocusIn> {
  101. if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
  102.     focus .menu
  103. }
  104.     }
  105.     tk_menuBar .menu .menu.file .menu.group1 .menu.ps
  107.     # Set up a class binding to allow objects to be deleted from a canvas
  108.     # by clicking with mouse button 1:
  110.     bind Canvas <1> {%W delete [%W find closest %x %y]}
  112.     concat ""
  113. } {}
  115. if {![testConstraint userInteraction]} {
  116.     cleanupTests
  117. } else {
  118.     vwait EndOfVisualTests
  119. }