Thread Tk-Hlist - Zeilen einfärben (6 answers)
Opened by Kean at 2011-05-13 14:45

pktm
 2011-05-17 16:41
#148730 #148730
User since
2003-08-07
2921 articles
BenutzerIn
[Homepage]
user image
Habe mal ein bisschen gesucht: "Multicolumn listbox with individual cell styles"

Siehe: http://objectmix.com/perl/19287-selectbackground-c... und http://cpansearch.perl.org/src/NI-S/Tk-804.027/dem...

Daraus kann man was lauffähiges machen:
more (3.8kb):
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
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
#!perl
# HList and ItemStyle, multicolumn listbox with individual cell styles.
# -*- perl -*-

#
# $Id: $
# Author: Slaven Rezic
#
# Copyright (C) 1999 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: eserte@cs.tu-berlin.de
# WWW: http://user.cs.tu-berlin.de/~eserte/
#

use Tk;
use Tk::HList;
use Tk::ItemStyle;

my $mw = tkinit();

my $h = $mw->Scrolled('HList',
-header => 1,
-columns => 4,
-width => 50,
-height => 20,
)->grid(qw/-sticky nsew/);

for (0 .. 3) {
$h->header('create', $_, -text => 'Column ' . $_);
}

my(@fonts) = ('-*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-*',
'-*-Courier-Medium-R-Normal--*-180-*-*-*-*-*-*',
'-*-times-medium-r-normal--*-240-*-*-*-*-*-*',
'-Adobe-Courier-Bold-O-Normal--*-120-*-*-*-*-*-*',
'fixed',
);

my(@colors) = qw(red green blue yellow red cyan black);

my $rnd_font = sub {
$fonts[rand($#fonts+1)];
};
my $rnd_color = sub {
$colors[rand($#colors+1)];
};
my $rnd_image = sub {
my $yn = int(rand(2));
if ($yn) {
$img[rand($#img+1)];
} else {
undef;
}
};
my $rnd_window = sub {
my $yn = int(rand(10));
if ($yn == 3) {
('Button', 'Entry')[rand(2)];
} else {
undef;
}
};

for my $y (0 .. 20) {
my $e = $h->addchild("");
for my $col (0 .. 3) {
my $window = $rnd_window->();
my $image = $rnd_image->();
my $fg = $rnd_color->();
my $bg = $rnd_color->();
if ($bg eq $fg) { $fg = 'white' }

my $style_type = ($window ? 'window' : ($image ? 'imagetext' : 'text'));
my $btn;
my $style = $h->ItemStyle($style_type);
if ($style_type eq 'window') {
$style->configure(-pady => 0, -padx => 0, -anchor => "nw");
if ($window eq 'Button') {
$btn = $h->Button(
-text => 'Click me!',
-command => sub {
$btn->configure(-activeforeground => $rnd_color->());
},
);
} else {
$btn = $h->Entry;
}
} else {
$style->configure(-foreground => $fg,
-background => $bg,
-font => $rnd_font->(),
);
}
$h->itemCreate($e, $col,
-itemtype => $style_type,
-style => $style,
($style_type eq 'imagetext'
? (-image => $image) : ()
),
($style_type eq 'window'
? (-widget => $btn) : (-text => 'Cell ' . $y . '/' . $col)
),
);
}
}

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


hth, pktm
http://www.intergastro-service.de (mein erstes CMS :) )

View full thread Tk-Hlist - Zeilen einfärben