#!perl -w
# Show all the standard images that can be loaded using
# Win32::GUI::Icon->new(ID)
# Win32::GUI::Cursor->new(ID) and
# Win32::GUI::Bitmap->new(ID)
#
# Robert May, May 2006
#
use strict;
use warnings;
use Win32::GUI 1.03_03, qw(CW_USEDEFAULT :icon :cursor :bitmap);
my ($icon, $cursor, $bitmap);
my @icons = sort grep /^IDI_|^OIC_/, @{Win32::GUI::Constants::_export_ok()};
my @cursors = sort grep /^IDC_|^OCR_/, @{Win32::GUI::Constants::_export_ok()};
my @bitmaps = sort grep /^OBM_/, @{Win32::GUI::Constants::_export_ok()};
my @menu_defn = (
"File" => "File",
">Exit" => { -name => "Exit", -onClick => sub{-1}, },
);
push @menu_defn, "Icons", "Icon";
for my $i (@icons) {
push @menu_defn, ">$i", { -name => $i, -onClick => eval "sub {showIcon(\"$i\")}", };
}
push @menu_defn, "Cursors", "Cursor";
for my $i (@cursors) {
push @menu_defn, ">$i", { -name => $i, -onClick => eval "sub {showCursor(\"$i\")}", };
}
push @menu_defn, "Bitmaps", "Bitmap";
for my $i (@bitmaps) {
push @menu_defn, ">$i", { -name => $i, -onClick => eval "sub {showBitmap(\"$i\")}", };
}
my $menu = Win32::GUI::Menu->new(@menu_defn);
my $mw = Win32::GUI::Window->new(
-title => "Standard Win32 Icons, Cursors and Bitmaps",
-size => [400,300],
-left => CW_USEDEFAULT,
-menu => $menu,
);
$mw->AddLabel(
-name => 'ICO',
-pos => [30,10],
-size => [32, 32],
-icon => 0,
);
$mw->AddLabel(
-name => 'CUR',
-pos => [80,10],
-size => [32, 32],
-icon => 0,
);
$mw->AddLabel(
-name => 'BMP',
-pos => [130,10],
-size => [100, 100],
-bitmap => 0,
);
$mw->Show();
Win32::GUI::Dialog();
$mw->Hide();
undef $mw;
exit(0);
sub showIcon {
$menu->{$icon->{_current}}->Checked(0) if($icon);
my $new = shift;
$menu->{$new}->Checked(1);
$icon = Win32::GUI::Icon->new(eval $new) or die "No icon: $new";
$icon->{_current} = $new;
$mw->ICO->Change(-icon => $icon);
$mw->SetIcon($icon);
return 0;
}
sub showCursor {
$menu->{$cursor->{_current}}->Checked(0) if($cursor);
my $new = shift;
$menu->{$new}->Checked(1);
$cursor = Win32::GUI::Cursor->new(eval $new) or die "No icon: $new";
$cursor->{_current} = $new;
$mw->CUR->Change(-icon => $cursor);
$mw->ChangeCursor($cursor);
return 0;
}
sub showBitmap {
$menu->{$bitmap->{_current}}->Checked(0) if($bitmap);
my $new = shift;
$menu->{$new}->Checked(1);
$bitmap = Win32::GUI::Bitmap->new(eval $new) or die "No icon: $new";
$bitmap->{_current} = $new;
$mw->BMP->Change(-bitmap => $bitmap);
return 0;
}