| Jack D. 2004-10-13, 3:55 am |
| This is a multi-part message in MIME format.
------=_NextPart_000_0000_01C4B08E.186A49C0
Content-Type: text/plain;
charset="us-ascii"
Content-Transfer-Encoding: 7bit
Please accept this HList.pm patch to allow balloons to be attached to HList
entries (as requested a few w s back on c.l.p.t. )
http://groups.google.ca/groups? sel...%40
local
host.talkaboutprogramming.com
The sub is very similar to the BalloonInfo sub for Tk::Canvas (ala Mr.
Rezic). A hash is used for an HList as well - but instead of canvas "items"
as the keys - the "entrypaths" are used for the HList.
While doing this - I think I found a bug with the info('bbox') method. It
doesn't seem to take into account any headers which may be showing. I worked
around this in the code by checking for a header in the zeroeth column and
using it's height to adjust the y pixels.
There are two attachments - one is the patch. The other is a test script
blatently hacked from the widget demo to show the balloons. If this is
accepted - then an HList should be added to the Balloon demonstration.
Jack
------=_NextPart_000_0000_01C4B08E.186A49C0
Content-Type: application/octet-stream;
name="Hlist.diff"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="Hlist.diff"
--- HList.pm Tue Dec 23 18:46:26 2003
+++ HList.pm.new Tue Oct 12 18:41:35 2004
@@ -675,6 +675,52 @@
@info;
}
=20
+sub BalloonInfo
+{
+ my ($hlist,$balloon,$X,$Y,@opt) =3D @_;
+ my $Ev =3D $hlist->XEvent;
+ return unless $Ev;
+
+ my $py =3D $Ev->y;
+ my $entrypath =3D $hlist->GetNearest($py,1);
+ return unless $entrypath;
+
+ my (undef,$topy,undef,$boty) =3D $hlist->info('bbox',$entrypath);
+
+ # Does hlist have a bug? If a header exists, then it is *not* taken =
into account
+ # when doing a infoBbox on an entrypath. So we have to manually add =
any header
+ # space to our returned info to get a true y value with respect to top =
corner.
+ # Make sure the mouse is really over an item (i.e. not a header or =
after the last item)
+
+ if ( $hlist->cget(-header) )
+ {
+ if ($hlist->header('exist', 0))
+ {
+ my $hh =3D $hlist->header('height');
+ $topy =3D $topy + $hh ;
+ $boty =3D $boty + $hh ;
+ }
+ }
+
+ if ( ($py <=3D $topy) or ($py > $boty) )
+ {
+ $balloon->Deactivate;
+ return;
+ }
+=20
+ foreach my $opt (@opt)
+ {
+ my $info =3D $balloon->GetOption($opt,$hlist);
+ if ($opt =3D~ /^-(statusmsg|balloonmsg)$/ && =
UNIVERSAL::isa($info,'HASH'))
+ {
+ $balloon->Subclient($entrypath);
+ return $info->{$entrypath} if (defined $info->{$entrypath});
+ return '';
+ }
+ return $info;
+ }
+}
+
1;
=20
=20
------=_NextPart_000_0000_01C4B08E.186A49C0
Content-Type: application/octet-stream;
name="testbal.pl"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="testbal.pl"
use Tk;
use Tk::HList;
use Cwd;
use subs qw/show_dir/;
use strict;
my %dirhash;
my $mw =3D tkinit;
my $h =3D $mw->Scrolled(qw\HList -separator / -selectmode extended =
-width 30
-height 20 -indent 35 -scrollbars se
-itemtype imagetext \
)->grid(qw/-sticky nsew/);
my $FILEIMG =3D $mw->Bitmap(-file =3D> Tk->findINC('file.xbm'));
my $FOLDIMG =3D $mw->Bitmap(-file =3D> Tk->findINC('folder.xbm'));
my $root =3D Tk->findINC('demos');
my $olddir =3D cwd;
chdir $root;
show_dir '.', $root, $h;
chdir $olddir;
my $b =3D $mw->Balloon(-initwait=3D>0);
$b->attach($h->Subwidget('scrolled'),
-balloonposition=3D>'mouse',
-msg =3D> \%dirhash);
MainLoop;
sub show_dir {
my($entry_path, $text, $h) =3D @_;
opendir H, $entry_path;
my(@dirent) =3D grep ! /^\.\.?$/, sort(readdir H);
closedir H;
$h->add($entry_path, -text =3D> $text, -image =3D> $FOLDIMG, -data =
=3D> 'DIR');
$dirhash{$entry_path} =3D $text;
while ($_ =3D shift @dirent) {
my $file =3D "$entry_path/$_";
if (-d $file) {
show_dir $file, $_, $h;
} else {
my $size =3D -s $file;
$h->add($file, -text =3D> $_, -image =3D> $FILEIMG, -data =3D> =
$size);
$dirhash{$file} =3D $_;
}
}
} # end show_dir
------=_NextPart_000_0000_01C4B08E.186A49C0--
-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server. If you wish to unsubscribe from this mailing list, send the
message body of "unsubscribe ptk" to majordomo@lists.stanford.edu
|