Trying again without a .zip file attachment.

Robert May wrote:
Here's another way. I've had an investigation of Icons and Bitmaps on my TODO list for a long time. I've learned a lot doing this, but not yet enough to start to think about how to integrate these sort of features into Win32::GUI.

My approach needs Win32::API, as I'm using the CreateIconIndirect() API, that's not in Win32::GUI right now, but otherwise everything needed is there.

There's probably more than Brian needs here, but as I say I was experimenting. Do with it as you see fit :-)

Regards,
Rob.

Plum, Jason wrote:

Thanks Jeremy. Nice, clean and mostly straight-through :)

See Brian, I told you someone more experienced with the bitmap module
would be able to provide a simple-ish way to do it.

We're here to help :)

Jason P.

-----Original Message-----
From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of
Jeremy White
Sent: Thursday, February 23, 2006 3:06 AM
To: [EMAIL PROTECTED]; perl-win32-gui-users@lists.sourceforge.net
Subject: RE: [perl-win32-gui-users] A slightly OT question, how to
create an icon on the fly



I'd like to be able to have an icon (displayed in the system tray) that


is

created "On the fly".  Something like the W2K/XP task manager icon, but



with
text indicating the percentage overlaid.

I know that I could do this by creating 100 discrete icons, but what a


pain

this would be. (Actually what I'd ultimately like to do would probably
require 1000 icons!)

Is there a module to create simple graphics?  I could create the icon,


and

use  BitmapInline to import/display it.

Can this be done, or am I crazy.



Hi,

This is the way I would do it. Create a off screen bitmap, paint your 'source' icon onto the bitmap, add the text that you need to the bitmap.

Now, create a off screen tool bar, add the bitmap to the toolbar, then
use the GetIcon method from the toolbar to create an icon that you can use
in the system tray.

You wont need any external modules.

Cheers,

jez.




-------------------------------------------------------
This SF.Net email is sponsored by xPML, a groundbreaking scripting
language
that extends applications into web and mobile media. Attend the live
webcast
and join the prime developer group breaking into this new coding
territory!
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=110944&bid=241720&dat=121642
_______________________________________________
Perl-Win32-GUI-Users mailing list
Perl-Win32-GUI-Users@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users
http://perl-win32-gui.sourceforge.net/



-------------------------------------------------------
This SF.Net email is sponsored by xPML, a groundbreaking scripting language that extends applications into web and mobile media. Attend the live webcast and join the prime developer group breaking into this new coding territory! http://sel.as-us.falkag.net/sel?cmd_______________________________________________
Perl-Win32-GUI-Users mailing list
Perl-Win32-GUI-Users@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users
http://perl-win32-gui.sourceforge.net/

use strict;
use warnings;

package Win32::GUI::Icon;

use Win32::API();

my $CreateIconIndirect = Win32::API->new('user32', 'CreateIconIndirect', 'P', 
'L')
        or die "Couldn't load CreateCursorIndirect()";

# TODO:
# - word alignment of all data.  Not doing this means that this code only 
supports
#   icons with a width that is a multiple of 16 pixels.
# - would be nice to have a way of specifying a transparent color, and 
generating
#   AND and XOR masks from it.
# - using a fixed 24bbp bitmap probaly has result that look terrible if 
displayed
#   usng 256 colours or less.
# - needs a complete refactor :-)

# New Win32::GUI::Icon constructor.
# with no parameters gives a 16x16 white icon
# parameters:
#   -width   - sets icon width in pixels.  Must be a multiple of 16.
#   -height  - sets icon height in pixels.
#   -andMask - string of '0's and '1's that specify the AND mask.
#              defaults to all '0's
#   -xorMask - string of '0's and '1's that specify the XOR mask.
#              defaults to all '1's
#   -bitmapData - string of hex characters in the format BBGGRR, with each
#                 6 characters giving the colour value for one pixel in the
#                 bitmap.  No defult, resulting in a monochrome icon defined
#                 by the AND and XOR masks.
#
# If you want to understand about transparancy, read MSDN for info about how
# the AND and XOR masks are used.
sub FromData
{
        my $class = shift;

        my %options = @_;

        my $width = exists($options{-width}) ? $options{-width} : 16;
        if($width < 1) {
                warn "-width must be greater than 0";
                return undef;
        }
        if($width % 16) {
                warn "-width must be a multiple of 16";
                return undef;
                #TODO: remove once alignment is done
        }

        my $height = exists($options{-height}) ? $options{-height} : 16;
        if($height < 1) {
                warn "-height must be greater than 0";
                return undef;
        }

        my $andMask;
        if (exists($options{-andMask})) {
                $andMask = $options{-andMask};
                $andMask =~ s/[^01]//g;
                if(length($andMask) != ($width * $height)) {
                        warn "-andMask specified wrong amount of data";
                        return undef;
                }
                #TODO: align
        }
        else {
                $andMask = "0" x ($width * $height);
                #TODO: align
        }


        my $xorMask;
        if (exists($options{-xorMask})) {
                $xorMask = $options{-xorMask};
                $xorMask =~ s/[^01]//g;
                if(length($xorMask) != ($width * $height)) {
                        warn "-xorMask specified wrong amount of data";
                        return undef;
                }
                #TODO: align
        }
        else {
                $xorMask = "1" x ($width * $height);
                #TODO: align
        }

        my $bitmapData;
        if (exists($options{-bitmapData})) {
                $bitmapData = $options{-bitmapData};
                $bitmapData =~ s/[^A-Za-z0-9]//g;
                if(length($bitmapData) != ($width * $height * 6)) {
                        warn "-bitmapData specified wrong amount of data";
                        return undef;
                }
                #TODO: align!
        }

        my $hMask = Win32::GUI::Bitmap::Create($width, (2 * $height), 1, 1,
                                        pack("B*", $andMask . $xorMask));
        if(!$hMask) {
                warn "Failed to create Icon Mask: $^E";
                return undef;
        }

        my $hBitmap = 0;
        if(defined $bitmapData && (length($bitmapData) > 0)) {
                $hBitmap = Win32::GUI::Bitmap::Create($width, $height, 1, 24,
                                        pack("H*", $bitmapData));
                if(!$hBitmap) {
                        warn "Failed to create Icon Mask: $^E";
                        Win32::GUI::DeleteObject($hMask);
                        return undef;
                }
        }

        my $ICONINFO = pack("iLLLL", 1, 0, 0, $hMask, $hBitmap);

        my $handle = $CreateIconIndirect->Call($ICONINFO);

        if(!$handle) {
                warn "Failed to create Icon: $^E";
        }

        Win32::GUI::DeleteObject($hMask);
        Win32::GUI::DeleteObject($hBitmap);

        if(!$handle) {
                return undef;
        }

        my $self = { -handle => $handle };

        return bless $self, $class;
}
#!perl -w
use strict;
use warnings;

use Win32::GUI();
use Icon;

# Code currently only works for widths that are multiples of
# 16 pixels. (this covers the standard sizes: 16, 32, 48)
my $width = 32;
my $height = 32;

# create the data for a left to right gradient, blue
# through white.
my $blue_data = '';
for (1 .. $height) {
        for my $col (1 .. $width) {
                $blue_data .= sprintf('FF%02x%1$02x', ((255*$col)/$width));
        }
}

my $icon = Win32::GUI::Icon->FromData(
        -width => $width,
        -height => $height,
        -bitmapData => $blue_data,
);

my $mw = Win32::GUI::Window->new(
        -title => "Runtime Icon",
        -size  => [400,300],
);

$mw->AddLabel(
        -icon => $icon,
        -pos  => [100,100],
        -size => [$width,$height],
);

$mw->Show();
Win32::GUI::Dialog();
exit(0);

Reply via email to