entry.wgt

来自「一个跨平台的TCL/TK可视开发环境类似VC. TCL/TK是一个跨平台的脚本」· WGT 代码 · 共 74 行

# $Id: entry.wgt,v 1.12 2003/04/07 00:21:47 cgavin Exp $

##############################################################################
#
# Visual TCL - A cross-platform application development environment
#
# Copyright (C) 2001 Damon Courtney
#
# Description file for Tk Widget
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

##############################################################################
#

Class		Entry
Lib		core

Icon		icon_entry.gif
DoubleClickCmd	vTcl:set_textvar
InsertCmd	vTcl::widgets::core::entry::insertCmd
TreeLabel	@vTcl::widgets::core::entry::getWidgetTreeLabel
DefaultValues   -foreground -highlightbackground \
                -highlightcolor -selectbackground -selectforeground
DefaultOptions  -background white
ClassOption     -_tooltip
Function        "Set Text Variable..." vTcl::widgets::core::entry::setTextVariable

## If we're using Tcl 8.4, we need to add the readonly option.
if {[info tclversion] > 8.3} {
    SpecialOpt -state "state" choice {normal disabled readonly}
} else {
    SpecialOpt -state "state" choice {normal disabled}
}

SpecialOpt -validate "Validate" choice {none focus focusin focusout key all}

namespace eval vTcl::widgets::core::entry {

    proc insertCmd {target} {
	set last [lindex [split $target .] end]
	set last [vTcl:rename $last]
	set name "[winfo toplevel $target]::$last"

	$target configure -textvariable $name
    }

    proc setTextVariable {} {
        global vTcl
        vTcl:core:set_option $vTcl(w,widget)\
                         -textvariable \
                         "Text Variable for $vTcl(w,widget)"
    }

    proc getWidgetTreeLabel {target} {
        set val [$target cget -textvariable]
	if {[lempty $val]} { set val NONE }
	return "VAR: $val"
    }
}