Advanced Search
Mail us
Home    Manuel    Links    Faq    Submit a tcl/tk Reference    Contact Us

    Some examples tcl/tk codes     Man of Bwidget     Man of blt     mkwidget screenshots     TkOgl     Video Demo real.

  How can I change the Tk cursor?
 On Unix, the file "/usr/include/X11/cursorfont.h" for a list of
available cursors.  You can use the names in there by removing the
`XC_`.  These same cursors are emulated on Windows/Mac. On the Mac you
can also use crsr and CURS style cursors by the name of the resource.
On Unix it possible to define your own cursors.  The `Tk_GetCursor` man
page describes this in detail, but in short you create an X bitmap file
like so:

#define face_width 16
#define face_height 12
#define face_x_hot 7
#define face_y_hot 7
static char face_bits[] = {
  0x00, 0x01, 0x30, 0x06, 0x0c, 0x18, 0x04, 0x10, 0x32, 0x26, 0x32, 0x26,
  0x01, 0x40, 0x81, 0x40, 0x09, 0x48, 0x12, 0x24, 0xe2, 0x23, 0x04, 0x10,
  0x0c, 0x18, 0x30, 0x06, 0xc0, 0x01, 0x00, 0x00};

and then configure your cursor with `. configure -cursor [list
@path_to_xbm_file fgColor]`

Here`s a little proc to make an entire application go busy while it`s
doing something. Just call it with the commands you want to execute, and
the watch cursor will be displayed for the time it takes the commands to
complete.  Note that any new windows will have their normal cursor.

proc busy {cmds} {
    global errorInfo

    set busy {.app .root}
    set list [winfo children .]
    while {[llength $list]} {
	set next {}
	foreach w $list {
	    set class [winfo class $w]
	    set cursor [lindex [$w configure -cursor] 4]
	    if {![string compare $w [winfo toplevel $w]] ||  [string compare {} $cursor]} {
		lappend busy [list $w $cursor]
	    set next [concat $next [winfo children $w]]
	set list $next

    foreach w $busy {
	catch {[lindex $w 0] configure -cursor watch}

    update idletasks

    set error [catch {uplevel eval [list $cmds]} result]
    set ei $errorInfo

    foreach w $busy {
	catch {[lindex $w 0] configure -cursor [lindex $w 1]}

    if {$error} {
	error $result $ei
    } else {
	return -code $error $result