Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Graphische Oberflächen
[thread]5273[/thread]

Tk: eigenes widget(canvas): Optionen werden nicht weitergeleitet?



<< >> 5 Einträge, 1 Seite
PerlProfi
 2006-12-26 16:20
#46046 #46046
User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]
Hallo,

Ich habe hier ein eigenes Widget, es ist ein wrapper um ein Tk::Canvas.
Ich lege für ein paar Optionen standard Werte fest, die auch richtig gesetzt werden, allerdings wird die Hintergrundfarbe des Canvas nicht auf schwarz gesetzt, obwohl ich schwarz als default Wert eingetragen habe.
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

package Tk::CanvasG;

require Tk::Frame;
@ISA = qw(Tk::Frame);
Construct Tk::Widget 'CanvasG';

use strict;
use warnings 'all';

use vars qw($VERSION);
$VERSION = '0.1.0';

use Data::Dumper;

#
# create the widget
#
sub Populate
{
    my($frame, $args) = @_;

    # get widget specific options
    my $bg =    delete $args->{-fieldbackground}    || delete $args->{-background}        || "black";
    my $fg =    delete $args->{-fieldforeground}    || delete $args->{-foreground}        || "lightgreen";

    # Populate Frame
    $frame->SUPER::Populate($args);

    # create advertised widget: Canvas
    print Dumper($bg, $fg);

    my $canvas = $frame            -> Canvas    (-background    => $bg)->pack
               
               
  (-fill        => "both",
               
               
   -expand    => 1);
    $frame               
     -> Advertise    ('canvas'    => $canvas);

    # delegates to frame
    $frame               
     -> Delegates    (DEFAULT    => $frame);

    # configure to canvas
    $frame               
     -> ConfigSpecs    ('-fieldbg'    => '-fieldbackground',
               
               
   '-fieldfg'    => '-fieldforeground',
               
               
   -fieldbackground => ["PASSIVE",
               
               
               
 "", "",
               
               
               
 "#000000"],
               
               
   -fieldforeground => ["PASSIVE",
               
               
               
 "", "",
               
               
               
 "#1fff1f"],
               
               
   DEFAULT    => [$canvas]);
} # Populate

# return true
1;

__END__

Als Ausgabe kommt:
Code: (dl )
1
2
$VAR1 = 'black';
$VAR2 = 'lightgreen';

Trotzdem bleibt das Canvas in der standard Tk Farbe.
Wenn ich allerdings nachträglich mit configure() -background setze, wird es verändert.

Weiß jemand Rat?

MfG PerlProfi\n\n

<!--EDIT|PerlProfi|1167142903-->
PerlProfi
 2006-12-27 23:45
#46047 #46047
User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]
Hier mal ein Beispiel Skript, was das Problem verdeutlicht:
Code: (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
#!/usr/bin/perl

package Test;

use base qw(Tk::Frame);
use Tk::widgets qw(Canvas);
Construct Tk::Widget 'Test';

use strict;
use warnings 'all';

sub Populate
{
    my($frame, $args) = @_;

    # create Frame
    $frame->SUPER::Populate($args);

    # create Canvas
    my $canvas = $frame->Canvas(-background => "black")->pack();
    $frame->Advertise('canvas' => $canvas);

    # delegates and configspecs
    $frame->Delegates  (DEFAULT => $frame);
    $frame->ConfigSpecs(DEFAULT => [$canvas]);

    return $frame;
} # Populate

package main;

use strict;
use warnings 'all';
use Tk;

my $mw   = tkinit();
my $test = $mw->Test()->pack();

MainLoop;

Ich setze -background auf "black", trotzdem bleibt das Canvas in der standard Tk Hintergrund Farbe Tk::NORMAL_BG.

Wenn ich jetzt nach dem my $test = $mw->Test()->pack(); noch ein $test->configure(-background => "black"); einfüge, wird die Hintergrundfarbe verändert.

Wie stelle ich es an, dass die Hintergrundfarbe des Canvas von Anfang an schwarz ist??

MfG PerlProfi
PerlProfi
 2007-01-03 12:55
#46048 #46048
User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]
Kann mir denn niemand sagen, wie das geht?

MfG PerlProfi
renee
 2007-01-03 13:19
#46049 #46049
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
So geht's:
Code: (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
#!/usr/bin/perl

package Test;

use base qw(Tk::Derived Tk::Frame);
use Tk::widgets qw(Canvas);
Construct Tk::Widget 'Test';

use strict;
use warnings 'all';

sub Populate
{
    my($frame, $args) = @_;

    $args->{-background} = 'black' unless defined $args->{-background};
    # create Frame
    $frame->SUPER::Populate($args);

    # create Canvas
    my $canvas = $frame->Component(Canvas => 'canvas',)->pack();

    # delegates and configspecs
    $frame->Delegates  (DEFAULT => $frame);
    $frame->ConfigSpecs(DEFAULT => [$canvas]);

    return $frame;
} # Populate

package main;

use strict;
use warnings 'all';
use Tk;

my $mw   = tkinit();
my $test = $mw->Test()->pack();

MainLoop;
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
PerlProfi
 2007-01-03 20:43
#46050 #46050
User since
2006-11-29
340 Artikel
BenutzerIn
[default_avatar]
Sehr vielen Dank, habs direkt mal übernommen.

MfG PerlProfi
<< >> 5 Einträge, 1 Seite



View all threads created 2006-12-26 16:20.