Re: [perl-win32-gui-users] Hyperlinks

[<Eva...@ao...>]

package Win32::GUI::HyperLink;

my $VERSION =3D "0.02";

use Win32::GUI;
use Win32::GUI::BitmapInline 0.02;
use Win32::API 0.20;

@ISA =3D qw( Win32::GUI::Label );


my $LoadCursor =3D new Win32::API("user32", "LoadCursor", "NN", "N");
my $ShellExecute =3D new Win32::API("shell32", "ShellExecute", "NPPPPI", "N"=
);
my $linkCursor =3D $LoadCursor->Call( 0, 32649 );

if(not $linkCursor) {
$linkCursor =3D newCursor Win32::GUI::BitmapInline( q(
AAACAAEAICAAAAwAAQDoAgAAFgAAACgAAAAgAAAAQAAAAAEABAAAAAAAgAIAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAACAAACAAAAAgIAAgAAAAIAAgACAgAAAgICAAMDAwAAAAP8AAP8AAAD//wD/AAAA
/wD/AP//AAD///8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATMREREQAAA
AAAAAAAAAAAEzEREREAAAAAAAAAAAAAABMxERERAAAAAAAAAAAAAAATMREREQAAAAAAAAAAAAAAE
zEREREAAAAAAAAAAAAAAAEQAAAAAAAAAAAAAAAAAAAB////4AAAAAAAAAAAAAAAAf///+AAAAAAA
AAAAAAAAB/////+AAAAAAAAAAAAAAH//////gAAAAAAAAAAAAAf///////gAAAAAAAAAAAAH////
///4AAAAAAAAAAAAf///////+AAAAAAAAAAAAH////////+AAAAAAAAAAAf/////////gAAAAAAA
AAAH/4j//////4AAAAAAAAAAf/gA//////+AAAAAAAAAAH+AB/////9/gAAAAAAAAAf4AAf/f/f4
D4AAAAAAAAAHcAAH+A+A+A+AAAAAAAAAAAAAB/gPgPgHcAAAAAAAAAAAAAf4D4D4AAAAAAAAAAAA
AAAH+A+AdwAAAAAAAAAAAAAAB/gHcAAAAAAAAAAAAAAAAAf4AAAAAAAAAAAAAAAAAAAH+AAAAAAA
AAAAAAAAAAAAB/gAAAAAAAAAAAAAAAAAAAf4AAAAAAAAAAAAAAAAAAAAdwAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAD////////////gA///4AP//+AD///gA///4AP///AH///wB///8Af//+AD///A
A///gAH//4AB//8AAf//AAD//gAA//4AAP/8AAD//CAA//hgAP/44AD//+AB///gB///4A///+B/
///h////4f///+H////h////8////////w=3D=3D
) );
}

my %linkFont =3D Win32::GUI::Font::Info(Win32::GUI::GetStockObject(17));
$linkFont{-underline} =3D 1;
my $linkFont =3D new Win32::GUI::Font( %linkFont );
my $linkClass =3D new Win32::GUI::Class(
    -name =3D> "Win32::GUI::HyperLink",
    -extends =3D> "STATIC",
    -cursor =3D> $linkCursor,
);

sub new {
    my $class =3D shift;
    my $parent =3D shift;
    my %options =3D @_;
    $options{-class} =3D $linkClass;
    $options{-foreground} =3D [0, 0, 255] unless exists $options{-foreground=
};
    $options{-font} =3D $linkFont unless exists $options{-font};
    $options{-notify} =3D 1;
   =20
    eval qq(
        sub main::$options{-name}_Click {
            Win32::GUI::HyperLink::OpenLink("\Q$options{-url}\E");     =20
        }          =20
    );  =20
    return new Win32::GUI::Label( $parent, %options ); =20
}

sub Win32::GUI::Window::AddHyperLink {
    return Win32::GUI::HyperLink->new(@_);
}

sub OpenLink {
    $ShellExecute->Call( 0, 0, shift, 0, 0, 6);
}

1;