Example: |
#!/usr/bin/wish
#cursors.tcl
#cxe- A program to test cursor bitmaps in the Tk environment.
#cxe- Center the mouse pointer in the crosshairs.
#cxe- Space for next cursor, backspace for the previous cursor, q to quit.
set X { X_cursor arrow based_arrow_down based_arrow_up boat bogosity
bottom_left_corner bottom_right_corner bottom_side bottom_tee
box_spiral center_ptr circle clock coffee_mug cross cross_reverse
crosshair diamond_cross dot dotbox double_arrow draft_large
draft_small draped_box exchange fleur gobbler gumby hand1 hand2 heart
icon iron_cross left_ptr left_side left_tee leftbutton ll_angle
lr_angle man middlebutton mouse pencil pirate plus question_arrow
right_ptr right_side right_tee rightbutton rtl_logo sailboat
sb_down_arrow sb_h_double_arrow sb_left_arrow sb_right_arrow
sb_up_arrow sb_v_double_arrow shuttle sizing spider spraycan star
target tcross top_left_arrow top_left_corner top_right_corner top_side
top_tee trek ul_angle umbrella ur_angle watch xterm }
#These cursors are also supported if using Windows
set Win { no starting size size_ne_sw size_ns size_nw_se size_we uparrow wait }
#These cursors are also supported if using a Mac
set Mac { text cross-hair }
#Create test space widgets
canvas .c -width 50 -height 50
.c create line 0 25 50 25 -fill gray
.c create line 25 0 25 50 -fill gray
label .l -width 20 -text "Press Space"
pack .c .l -side top
focus .c
#Bind keyboard controls
bind .c <space> {incr n}
bind .c <BackSpace> {incr n -1}
bind . <q> {destroy .;exit}; #Provide a bail out
#Manage status
set all [llength $X]; set n 0;
while 1 {
tkwait variable n;
set n [expr $n % $all]; set c [lindex $X $n];
.c configure -cursor $c; .l configure -text $c; }
|