
package Win32::GUI::HyperLink;

my $VERSION = "0.01";

use Win32::GUI;
use Win32::API;
use Win32::Process;
use Win32::TieRegistry;

@ISA = qw( Win32::GUI::Label );

my $LoadCursor = new Win32::API("user32", "LoadCursor", "NN", "N");
my $ShellExecute = new Win32::API("shell32", "ShellExecute", "NPPPPI", "N");
my $linkCursor = $LoadCursor->Call( 0, 32649 );
my %linkFont = Win32::GUI::Font::Info(Win32::GUI::GetStockObject(17));
$linkFont{-underline} = 1;
my $linkFont = new Win32::GUI::Font( %linkFont );
my $linkClass = new Win32::GUI::Class(
    -name => "Win32::GUI::HyperLink",
    -extends => "STATIC",
    -cursor => $linkCursor,
);

sub new {
    my $class = shift;
    my $parent = shift;
    my %options = @_;
    $options{-class} = $linkClass;
    $options{-foreground} = [0, 0, 255] unless exists $options{-foreground};
    $options{-font} = $linkFont unless exists $options{-font};
    $options{-notify} = 1;
    
    eval qq(
        sub main::$options{-name}_Click {
            Win32::GUI::HyperLink::OpenLink("\Q$options{-url}\E");      
        }           
    );   
    return new Win32::GUI::Label( $parent, %options );  
}

sub Win32::GUI::Window::AddHyperLink {
    return Win32::GUI::HyperLink->new(@_);
}

sub OpenLink {
    $ShellExecute->Call( 0, 0, shift, 0, 0, 6);
}


sub OpenLink_old {
    my($url) = @_;  
    if($ftype=getftype(".html")) {
        $ftype=~s/"//g; #"
        ($ftypeexe)=$ftype=~/^.*\\(.*\.exe)$/i;
        my ($process);
        Win32::Process::Create(
            $process,
            $ftype,
            "$ftypeexe $url",
            0,
            DETACHED_PROCESS,
            "."
        ) || warn "Create: $!";
    }
}

sub getftype {
    if (my ($ext) = @_) {
        if (my $typeName = $Registry->{"HKEY_CLASSES_ROOT\\$ext\\\\"}) {
            if (my $command = $Registry->{"HKEY_CLASSES_ROOT\\$typeName\\shell\\open\\command\\\\"}) {
                my ($cmd);
                unless (($cmd) = $command=~/^(".*")\s+.*$/) { 
                    ($cmd) = $command=~/^(\S*)\s/; 
                }
                return $cmd;
            } else { return 0; }
        } else { return 0; }
    } else { return 0; }
}

1;

