Thread [Tk] Referenz auf Tk Objekt (4 answers)
Opened by Kean at 2012-02-23 14:12

pktm
 2012-02-23 15:54
#156368 #156368
User since
2003-08-07
2921 Artikel
BenutzerIn
[Homepage]
user image
Meinst du sowas hier?

Code (perl): (dl )
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

use strict;
use warnings;
use Tk;

my $mw = MainWindow->new();

my $itemhref = build_widgets($mw);

$mw->MainLoop();
exit(0);


sub build_widgets {
        my $toplevel = shift or die('Missing toplevel widget');
        
        my $frame = $toplevel->Frame()->pack;
        my $name = $frame->Entry( )->pack;
        my $alter = $frame->Entry( )->pack;
        my $button = $frame->Button(
                -text => "Ausgabe",
                #-command => \&ausgabe,
        )->pack;

        my %map = (
                toplevel => $toplevel,
                frame => $frame,
                name => $name,
                alter => $alter,
                button => $button,
        );

        $button->configure(-command => sub{ ausgabe(\%map); return 1; });
        
        return \%map;
} # /build_widgets

sub ausgabe {
        my $itemhref = shift or die('Missing widget href');
        print $itemhref->{name}->get()." ". $itemhref->{alter}->get()."\n";
} # /ausgabe


Das kann man auch so umschreiben, dass die Sub als Argument übergeben wird.
Aber so besonder weit weg von einer Klasse ist das auch nicht mehr:

Code (perl): (dl )
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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

#!perl

package MyWidget;

use strict;
use warnings;
use Tk;

sub new {
        my $class = shift;
        my $toplevel = shift or die('Missing toplevel');
        
        my $self = bless({}, $class);
        $self->{todo_class_accessor_benutzen} = $self->build_widgets($toplevel);
        
        return $self;
} # /new

sub build_widgets {
        my $self = shift;
        my $toplevel = shift or die('Missing toplevel widget');
        
        my $frame = $toplevel->Frame()->pack;
        my $name = $frame->Entry( )->pack;
        my $alter = $frame->Entry( )->pack;
        my $button = $frame->Button(
                -text => "Ausgabe",
                #-command => \&ausgabe,
        )->pack;

        my %map = (
                toplevel => $toplevel,
                frame => $frame,
                name => $name,
                alter => $alter,
                button => $button,
        );

        $button->configure(-command => sub{ $self->ausgabe(); return 1; });
        
        return \%map;
} # /build_widgets

sub ausgabe {
        my $self = shift;
        my $itemhref = $self->{todo_class_accessor_benutzen};
        print $itemhref->{name}->get()." ". $itemhref->{alter}->get()."\n";
        
        return;
} # /ausgabe

1;

use strict;
use warnings;
use Tk;

my $mw = MainWindow->new();

my $w = MyWidget->new($mw);

$mw->MainLoop();

exit(0);
http://www.intergastro-service.de (mein erstes CMS :) )

View full thread [Tk] Referenz auf Tk Objekt