# 	$Id: skin.pm,v 1.13.2.14 2006/04/11 00:11:25 brian Exp $	

# Skin.pm
# Module to make skin creation easy
#
# (C) 2006 Brian Millham (bmillham#hughes.net), All Rights Reserved
#
# This program is free software.  You can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# Ideas for including bitmaps in the skin file were borrowed from
# Aldo Calpini's Win32::GUI::BitmapInline module
#
# The skin package overrides Win32::GUI::Window.
#
# At this time, it's not really Win32::GUI::Skin, the Skin.pm file
# should be in the same directory as the app.  The real reason for this is
# that like all good Perl programmers, I'm lazy and don't want to copy
# this over to the correct directory while testing ;-)
#
# Once it's decided that I'm on the right track, I'll make the changes
# to make the module truly Win32::GUI::Skin.
#
# Many thanks to the perl-win32-gui-users list for advice!
# If I've missed credit for any ideas used, please let me know so
# I can add them here.
#
# I also really need to add some POD documentation to this :-(

package Skin;

use Win32::GUI;
use Win32::API;
use Storable qw(fd_retrieve store_fd);
use File::Temp qw(tempfile);
use Compress::Zlib;

# Inherit Win32::GUI::Window
our @ISA = (Win32::GUI::Window);
our $AUTOLOAD;

my $VERSION = eval("0.1");

use strict;
use warnings;
use constant {
    SWP_FRAMECHANGED => 32,
    SWP_NOMOVE => 2,
    SWP_NOSIZE => 1,
    SWP_NOZORDER => 4,
    SWP_NOACTIVATE => 16,
    WM_NCLBUTTONDOWN => 161,
    HTCAPTION => 2,
    SMTO_NORMAL => 0,
    RGN_AND => 1,
    RGN_COPY => 5,
    RGN_DIFF => 4,
    RGN_OR => 2,
    RGN_XOR => 3,
    SRCCOPY => 0xCC0020,
};

# Import Win32::API functions
my $ExtCreateRegion = Win32::API->new("gdi32", "ExtCreateRegion", "PNP", "L")
    or die "Failed to import ExtCreateRegion";

my $SetWindowPos = Win32::API->new("user32","SetWindowPos", "LLLLLLL", "L")
    or die "Failed to load SetWindowPos";

# Create a Skin window, based on the Win32::GUI::Window object
# All normal Window options are used, except -onPaint.
# Additional options are:
# -skinfile = name of a skin file
# -skinpaint = same as -onPaint, but called when skinned, and
#              draws in the app area of the skin.
# -skinmenu = a normal Win32::GUI::Menu object that will be used
#             for a right-click popup menu in skin mode.
# -startskinned = 1: to start in skin mode, otherwise starts as a
#                 normal window.
# -createskin = 1: a special option used by Skin::Create
#
# You cannot use the -onPaint option at this time, since it will cause
# problems in skin mode.

sub new
{
    my $invocant = shift;
    my $class = ref($invocant) || $invocant;
    my %options = @_;

# Kill -onPaint if it was defined
    if (defined $options{-onPaint}) {
	warn "Can not use -onPaint with a Skin window, use -skinpaint instead.";
	delete $options{-onPaint};
    }

# Save the coderef for the -skinpaint option
    my $coderef = $options{-skinpaint} if defined $options{-skinpaint};

# Create the window, using Win32::GUI::Window
# The custom options are ignored when creating the window

    my $self = $class->SUPER::new(%options);

# Hook the paint event with our own special paint to draw the bitmaps,
# title and labels.
# An optional coderef can also be used to create custom graphics drawn
# in the app area.
# The _Paint OEM method should not be used, as it may overright what's
# drawn here.

    $self->SetEvent('Paint', sub {
	$self->PaintSkin($self->GetDC, $coderef)
    }) if !defined $options{-createskin};

# Hook the MouseDown event for skin dragging
# This sends windows a mouse click event on the caption
# to fake windows into thinking that the caption was clicked
# to drag the window

    $self->SetEvent('MouseDown', sub {
	return if !$self->{isSkin};
	Win32::GUI::SendMessage($self, WM_NCLBUTTONDOWN, HTCAPTION, 0);
      });

# Hook the MouseRightDown event to show the skin menu while skinned

    $self->SetEvent('MouseRightDown', sub {
	return if !$self->{isSkin};
	my ($x, $y) = Win32::GUI::GetCursorPos();
	$self->TrackPopupMenu($self->{-skinmenu}->{Pop});
    }) if !defined $options{-createskin};


# Since the custom options were ignored, add them to our new object
    $self->{-skinfile} = $options{-skinfile};
    $self->{-windowmenu} = $options{-menu};
    $self->{-skinmenu} = $options{-skinmenu};
    $self->{-startskinned} = $options{-startskinned};

# Save the original height
    $self->{saveHeight} = $options{-height};
    $self->{saveWidth} = $options{-width};

# Load the skin file
    $self->loadSkin;

    bless $self, $class;

# Switch to skin mode, if requested.
    $self->ShowSkin if $self->{-startskinned};
    return $self;
}

sub Version {
    return $VERSION;
}

# Adds a normal Win32::GUI::Button object, but save additional data for
# class use.

sub AddButton {
    return Skin::Button->new(@_);
}

# Adds a skin label, or a normal Win32::GUI::Label object
# Special options:
# -skinlabel => 0 (not a skin label), 1 (skin only), 2 (both skin and normal)
# -skintop: Required for skin labels.  The top position (relative to the app area)
# -skinleft: Requred for skin labels. The left position (relative to the app area)

sub AddLabel {
    return Skin::Label->new(@_);
}

# Load a skin file

sub loadSkin
{
    my $self = shift;
    my $skinfile = shift;

# Load the skinfile specified when creating the window if a skinfile is
# not specified
    $skinfile = $self->{-skinfile} if !defined($skinfile);

    if (!defined($skinfile)) {
# If no skinfile is given, prompt for a skin file.
#	$self->SelectSkinFile;
# Don't continue, since SelectSkinFile loads the file
	return;
    }

    die "You must select or supply a skinfile!" if !defined($skinfile);
    die "Skinfile $skinfile does not exist" if !-e $skinfile;
    my $temphandle = tempfile();

# Read the compressed skinfile
    open(F, "<$skinfile");
    binmode(F);
    my $c;
    while(<F>) {
	$c .= $_;
    }

# Write the uncompressed skin data to a temp file

    print $temphandle uncompress($c);
    close(F);

# Return to the beginning of the temp file
    seek($temphandle, 0, 0);
# Get the skin data from the temp file
    my $skinData = fd_retrieve($temphandle);
# Close (and remove) the temp file
    close($temphandle);

# Load the rest of the skin info into the object
    foreach my $k (keys %{$skinData}) {
	$self->{$k} = $skinData->{$k};
    }

# Create the bitmaps
    $self->{closeBtn} = $self->_createBMP($self->{closeBMP});
    $self->{minBtn} = $self->_createBMP($self->{minBMP});
    $self->{skin} = $self->_createBMP($self->{skinBMP});

# Create the skin object
    $self->{dcSkin} = Win32::GUI::DC::CreateCompatibleDC(0);
    $self->{dcSkin}->SelectObject($self->_createBMP($self->{skinBMP}));

# Create the close button object
    $self->{dcClose} = Win32::GUI::DC::CreateCompatibleDC(0);
    $self->{dcClose}->SelectObject($self->_createBMP($self->{closeBMP}));

# Create the min button object
    $self->{dcMin} = Win32::GUI::DC::CreateCompatibleDC(0);
    $self->{dcMin}->SelectObject($self->_createBMP($self->{minBMP}));

# Create other needed objects
    $self->{titleFontObj} = Win32::GUI::Font->new(
						 -size => $self->{titleFontSize},
						 -face => $self->{titleFont},
						 -bold => $self->{titleFontBold},
						 );

    $self->{appFontObj} = Win32::GUI::Font->new(
						-size => $self->{appFontSize},
						-face => $self->{appFont},
						-bold => $self->{appFontBold},
					       );

    $self->{appFillColor} = 0xFFFFFF if !defined $self->{appFillColor};
    $self->{appFillBrush} = new Win32::GUI::Brush(-style => 0,
						  -color => $self->{appFillColor},
						  );

# Create the app area region
    $self->{appAreaRgn} = $ExtCreateRegion->Call(0, length($self->{appRegion}),
						 $self->{appRegion});

    $self->{isSkin} = 0;
    $self->{skinLoaded} = 1;

# Clean up, remove the in-memory bitmaps
    delete $self->{closeBMP};
    delete $self->{minBMP};
    delete $self->{skinBMP};
    undef $skinData;


# Add the skin labels

    foreach my $l (keys %{$self->{Labels}}) {
	$self->{$l} = $self->AddLabel(%{$self->{Labels}->{$l}});
    }

# Add the skin minimize button

    $self->{btnMin} = $self->AddButton(-name => 'btnMin',
				       -height => $self->skinRgnHeight('minRegion'),
				       -width => $self->skinRgnWidth('minRegion'),
				       -left => $self->skinRgnLeft('minRegion'),
				       -top => $self->skinRgnTop('minRegion'),
				       -bitmap => $self->{minBtn},
				       -tip => "Minimize",
				       -flat => 1,
				       -skinbtn => 1,
# Minimize the app when the skin min button is clicked
				       -onClick => sub {$self->Minimize},
				       );
# Hide the button if not in skin mode.
    $self->{btnMin}->Hide if !$self->{isSkin};;

    $self->{btnClose} = $self->AddButton(-name => "btnClose",
					 -height => $self->skinRgnHeight('closeRegion'),
					 -width => $self->skinRgnWidth('closeRegion'),
					 -left => $self->skinRgnLeft('closeRegion'),
					 -top => $self->skinRgnTop('closeRegion'),
					 -bitmap => $self->{closeBtn},
					 -tip => "Close",
					 -flat => 1,
					 -skinbtn => 1,
# Close the app when the skin close button is clicked
					 -onClick => sub {return -1},
				       );
# Hide the button on startup
    $self->{btnClose}->Hide if !$self->{isSkin};
}

# Unloads a skin from memory, clearing all the skin objects

sub UnloadSkin {
    my $self = shift;

# Don't unload while in skin mode!
    return if !$self->{skinLoaded};

# Remove the skin from memory
    delete $self->{appAreaRgn};
    delete $self->{appFontObj};
    delete $self->{titleFontObj};
    delete $self->{dcMin};
    delete $self->{dcClose};
    delete $self->{dcSkin};
    delete $self->{skin};
    delete $self->{minBtn};
    delete $self->{closeBtn};
    delete $self->{Labels};
    delete $self->{appFillColor};
    delete $self->{appFillBrush};
    $self->{isSkin} = 0;
    $self->{skinLoaded} = 0;
    $self->{-skinfile} = '';
}

# Returns true if the window is skinned, false otherwise

sub isSkinned {
    my $self = shift;

    return $self->{isSkin};
}

# Paint the bitmaps and title on the skin
# The OEM model may also be used to add additional graphics and text to the skin

sub PaintSkin {
    my $self = shift;
    my $dc = shift;
    my $coderef = shift;

# Paint the bitmaps to the skin
    if ($self->{isSkin}) {
	my ($left, $top, $width, $height) = $self->_getSkinRgnRect('skinRegion');

	$dc->BitBlt(0, 0, $width + $left, $height + $top,
		    $self->{dcSkin}->{-handle}, 0, 0, SRCCOPY);
	$dc->BitBlt($self->_getSkinRgnRect('closeRegion'),
		    $self->{dcClose}->{-handle}, 0, 0, SRCCOPY);
	$dc->BitBlt($self->_getSkinRgnRect('minRegion'),
		    $self->{dcMin}->{-handle}, 0, 0, SRCCOPY);

	$dc->FillRgn($self->{appAreaRgn}, $self->{appFillBrush}->{-handle});
	$dc->BkMode(1);

# Add the App title. Uses the windows title
	$dc->SelectObject($self->{titleFontObj}->{-handle});
	$dc->TextColor($self->{titleFontRGB});

# Chop the title down to the allowed length, and add ...
# This creates windows like behavior on the title.  However,
# you should really design the skin so that this doesn't happen...
	my $sText = $self->Text;
	my ($w, $h) = $dc->GetTextExtentPoint($sText);
	while ($w > $self->{titleTextWidth}) {
	    $sText =~ s/.$//; # Delete the last char
	    ($w, $h) = $dc->GetTextExtentPoint($sText);
	}

# It fits now.  If the new length doesn't match the old length, chop
# off three more chars, and replace them with ...
	$sText =~ s/...$/\.\.\./ if length($sText) != length($self->Text);
	$dc->TextOut($self->{titleLeft}, $self->{titleTop}, $sText);
	$dc->SelectObject($self->{appFontObj}->{-handle});
	$dc->TextColor($self->{appFontRGB});

# Set the clipping region
	$dc->SelectClipRgn($self->{appAreaRgn});

# Call the additional paint event for user defined drawing.
# Because of the clipping region, only the app area will be drawn on here.
	&$coderef($dc, Win32::GUI::Region::GetRgnBox($self->{appAreaRgn})) if defined($coderef);

# Add the skin labels.  The position is offset automatically to show in
# the app region.

	foreach my $l (@{$self->{skinlabels}}) {
	    $dc->TextOut($self->skinRgnLeft('appRegion') + $self->{$l}->{-skinleft},
			 $self->skinRgnTop('appRegion') +  $self->{$l}->{-skintop},
			 $self->{$l}->Caption);
	}

# Validate the DC.
	$dc->Validate;
    }
    return 1;
}

# Returns the height of the window in normal mode.
# If called when in skin mode, the normal window mode height is
# still returned.

sub Height {
    my $self = shift;

    if ($self->{isSkin}) {
	return $self->{saveHeight};
    } else {
	return $self->SUPER::Height();
    }
}

# Same as above, except for Width.
sub Width {
    my $self = shift;

    if ($self->{isSkin}) {
	return $self->{saveWidth};
    } else {
	return $self->SUPER::Width();
    }
}

# Show the skin
sub ShowSkin {
    my $self = shift;

    return 1 if $self->{isSkin};

# If no skin file is loaded, prompt to load a file.
    if (!$self->{skinLoaded}) {
	  my $ans = $self->MessageBox("Would you like to select a skin file?", "No skin file was selected", MB_YESNO | MB_ICONQUESTION);
	  return if $ans == IDNO;
	  $self->SelectSkinFile;
    }
    $self->{isSkin} = 1;

# Save the size of the normal window, so we can restore it when removing
# the skin
    $self->{saveHeight} = $self->Height;
    $self->{saveWidth} = $self->Width;

# Re-size the window to fit the skin
    my ($left, $top, $width, $height) = $self->_getSkinRgnRect('skinRegion');
    $self->Resize($width + $left, $height + $top);

# Remove the caption and the borders
    $self->Change(-popstyle => WS_CAPTION);
    $self->Change(-popstyle => WS_SIZEBOX);

# Remove the menu
    $self->SetMenu(0);

# Force the changes to the window
    $SetWindowPos->Call($self->{-handle}, 0, 0, 0, 0, 0,
			SWP_FRAMECHANGED|SWP_NOMOVE|SWP_NOSIZE|
			SWP_NOACTIVATE|SWP_NOZORDER);

# Show the region, making the window show with the skin outline
    $self->SetWindowRgn($ExtCreateRegion->Call(0, length($self->{skinRegion}),
					 $self->{skinRegion}), 1);

# Show the skin buttons
    foreach my $b (@{$self->{skinbuttons}}) {
	$self->{$b}->Show;
    }

# Hide the normal window buttons
    foreach my $b (@{$self->{windowbuttons}}) {
	$self->{$b}->Hide;
    }

# Hide the normal window labels
    foreach my $l (@{$self->{windowlabels}}) {
	$self->{$l}->Hide;
    }

# Force a paint event (to redraw the window)
    $self->InvalidateRect(1);
    return 1;
}

# Hide the skin, reverting to a normal window.
sub HideSkin {
    my $self = shift;

    return 1 if !$self->{isSkin};

    # Remove the region
    $self->SetWindowRgn(0, 1);

# Restore the width and height of the un-skinned window
    $self->Resize($self->{saveWidth}, $self->{saveHeight});

# Restore the caption and borders
    $self->Change(-pushstyle => WS_CAPTION);
    $self->Change(-pushstyle => WS_SIZEBOX);

# Restore the menu
    $self->SetMenu($self->{-windowmenu}->{-handle});

# Force the window update
    $SetWindowPos->Call($self->{-handle}, 0, 0, 0, 0, 0,
			SWP_FRAMECHANGED|SWP_NOMOVE|SWP_NOSIZE|
			SWP_NOACTIVATE|SWP_NOZORDER);

# Hide the skin buttons
    foreach my $b (@{$self->{skinbuttons}}) {
	$self->{$b}->Hide;
    }

# Show the normal window buttons
    foreach my $b (@{$self->{windowbuttons}}) {
	$self->{$b}->Show;
    }

# Show the normal window labels
    foreach my $l (@{$self->{windowlabels}}) {
	$self->{$l}->Show;
    }

    $self->{isSkin} = 0;

# Force a redraw
    $self->InvalidateRect(1);
    return 1;
}

# _createBMP
# usage: $skin->createBMP($bitmapInMemory)
# returns: the bitmap object
# This is meant to be an internal function

sub _createBMP {
    my $self = shift;
    my $b = shift;

# Create a temp file
# This is based on the BitmapInline code!
    open(B, ">~$$.tmp");
    binmode(B);
# save the in memory bitmap to the temp file
    print B $b;
    close(B);

# Create a bitmap object
    my $ret = Win32::GUI::Bitmap->new("~$$.tmp") or die "can't create bitmap";

# Remove the temp file
    unlink("~$$.tmp");
    return $ret;
}

# Returns the region information in an array.
# Fields returned are:
# dwSize
# iType
# nCount
# nRgnSize
# left
# top
# right
# bottom
# buffer

sub _getSkinRgnInfo {
    my $self = shift;
    my $rgn = shift;

    return unpack("LLLLLLLLC*", $self->{$rgn});
}

sub _getSkinRgnRect {
    my $self = shift;
    my $rgn = shift;

    return ($self->skinRgnLeft($rgn), $self->skinRgnTop($rgn),
	    $self->skinRgnWidth($rgn), $self->skinRgnHeight($rgn));
}

sub skinRgnHeight {
    my $self = shift;
    my $rgn = shift;

    return $self->skinRgnBottom($rgn) - $self->skinRgnTop($rgn);
}

sub skinRgnWidth {
    my $self = shift;
    my $rgn = shift;

    return $self->skinRgnRight($rgn) - $self->skinRgnLeft($rgn);
}

sub skinRgnRight {
    my $self = shift;
    my $rgn = shift;

    return ($self->_getSkinRgnInfo($rgn))[6];
}

sub skinRgnBottom {
    my $self = shift;
    my $rgn = shift;

    return ($self->_getSkinRgnInfo($rgn))[7];
}

sub skinRgnLeft {
    my $self = shift;
    my $rgn = shift;

    return ($self->_getSkinRgnInfo($rgn))[4];
}

sub skinRgnTop {
    my $self = shift;
    my $rgn = shift;

    return ($self->_getSkinRgnInfo($rgn))[5];
}

# Select a new skin
# Unloads the current skin, and loads the new skin

sub SelectSkinFile {
    my $self = shift;

    my $sf = Win32::GUI::GetOpenFileName(
					 -owner => $self,
					 -size => [400, 400],
					 -title => 'Select Skin File',
					 -filter => ['Skin files (*.pwgs)', '*.pwgs',
						     'All files (*.*)', '*.*'],
					 );

    return 1 if !$sf;
    if (!-e $sf) {
	$self->MessageBox("File Not Found", "$sf not found.");
	return 1;
    }

# Unload the current skin, if one is loaded
    my $wasSkinned = $self->isSkinned;

    $self->UnloadSkin if defined $self->{skinLoaded};
    my $savewidth = $self->{saveWidth};
    my $saveheight = $self->{saveHeight};
    $self->{-skinfile} = $sf;
    $self->loadSkin;
    $self->{isSkin} = $wasSkinned;
    if ($self->isSkinned) {
	$self->{isSkin} = 0; # Fake showskin into showing again
	$self->ShowSkin;
	$self->{saveWidth} = $savewidth;
	$self->{saveHeight} = $saveheight;

    }
    return 1;
}

# Warn if an invalid method is called
sub AUTOLOAD {
    my $self = shift;

    warn "$AUTOLOAD is not a valid method.\n";
}

# The overridden button method

package Skin::Button;
our @ISA = qw(Win32::GUI::Button);

sub new {
    my ($class, $parent, @options) = @_;
    my %options = @options;

    if (exists $options{-skinbtn}) {
	push @{$parent->{skinbuttons}}, $options{-name};
    } else {
	push @{$parent->{windowbuttons}}, $options{-name};
    }

    # Save the object
    $parent->{$options{-name}} = new Win32::GUI::Button($parent, @options);

    return $parent->{$options{-name}};
}

# The overridden label method

package Skin::Label;
our @ISA = qw(Win32::GUI::Label);

sub new {
    my ($class, $parent, @options) = @_;
    my %options = @options;

    if (exists $options{-skinlabel}) {
	push @{$parent->{skinlabels}}, $options{-name};
    } else {
	push @{$parent->{windowlabels}}, $options{-name};
    }
# This label is show in text and skin mode
    if (defined $options{-top} && defined $options{-skinlabel}) {
	push @{$parent->{windowlabels}}, $options{-name};
    }

    $parent->{$options{-name}} = new Win32::GUI::Label($parent,
						       @options);

# Copy the special skin options into the label object
    if (exists $options{-skinlabel}) {
	$parent->{$options{-name}}->{-skintop} = $options{-skintop};
	$parent->{$options{-name}}->{-skinleft} = $options{-skinleft};
	$parent->{$options{-name}}->{-skinlabel} = $options{-skinlabel};

# Hide skin labels, they are never truly shown as a label, but written
# to the DC with TextOut. Don't hide labels if they are to be displayed
# in both modes.
	$parent->{$options{-name}}->Hide if $options{-skinlabel} == 1;
    }

    return $parent->{$options{-name}};
}

1;