Guest styx-ccHi..
Bau dir die Funktion doch in CheckButton.pm ein, habe einige Tk-Widgets die nicht wirklich das tun was ich mir vorstelle und habe festgestellt, dass die Quelltexte doch recht gut zu lesen und somit auch gut auf die eignene Bedürfnisse anzupassen sind.
MfG
So habs geschafft. Hier das Ergebnis, falls das noch jemand benötigt:
Checkbutton.pm:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
package Tk::Checkbutton;
# Conversion from Tk4.0 button.tcl competed.
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
# This program is free software; you can redistribute it and/or
use vars qw($VERSION);
$VERSION = '4.006'; # $Id: //depot/Tkutf8/Tk/Checkbutton.pm#6 $
# modify it under the same terms as Perl itself, subject
# to additional disclaimer in license.terms due to partial
# derivation from Tk4.0 sources.
require Tk::Widget;
require Tk::Button;
use base qw(Tk::Button);
Construct Tk::Widget 'Checkbutton';
sub Tk_cmd { \&Tk::checkbutton }
sub ClassInit
{
my ($class,$mw) = @_;
$mw->bind($class,'<Enter>', 'Enter');
$mw->bind($class,'<Leave>', 'Leave');
$mw->bind($class,'<1>', 'Invoke');
$mw->bind($class,'<space>', 'Invoke');
return $class;
}
sub Invoke
{
my $w = shift;
$w->invoke() unless($w->cget('-state') eq 'disabled');
}
sub get
{
my $class = shift;
return ${$class->cget('-variable')};
}
1;
P.S.: Renee du bist doch einer der Maintainer.. oder?
Last edited: 2009-04-02 12:13:36 +0200 (CEST)