package Spreadsheet::WriteExcelXML::Format; ############################################################################### # # Format - A class for defining Excel formatting. # # # Used in conjunction with Spreadsheet::WriteExcelXML # # Copyright 2000-2010, John McNamara, jmcnamara@cpan.org # # Documentation after __END__ # use Exporter; use strict; use Carp; use vars qw($AUTOLOAD $VERSION @ISA); @ISA = qw(Exporter); $VERSION = '0.13'; ############################################################################### # # new() # # Constructor # sub new { my $class = shift; my $self = { _xf_index => shift || 0, _palette => shift, _font_index => 0, _font => 'Arial', _size => 10, _bold => 0, _italic => 0, _color => 0x0, _underline => 0, _font_strikeout => 0, _font_outline => 0, _font_shadow => 0, _font_script => 0, _font_family => 0, _font_charset => 0, _num_format => undef, _hidden => 0, _locked => 1, _text_h_align => 0, _text_wrap => 0, _text_v_align => -1, _text_justlast => 0, _rotation => 0, _text_vertical => 0, _fg_color => 0x00, _bg_color => 0x00, _pattern => 0, _bottom => 0, _top => 0, _left => 0, _right => 0, _bottom_color => 0x0, _top_color => 0x0, _left_color => 0x0, _right_color => 0x0, _indent => 0, _shrink => 0, _merge_range => 0, _reading_order => 0, _diag_type => 0, _diag_color => 0x0, _diag_border => 0, _just_distrib => 0, }; bless $self, $class; # Set properties passed to Workbook::add_format() $self->set_properties(@_) if @_; return $self; } ############################################################################### # # copy($format) # # Copy the attributes of another Spreadsheet::WriteExcelXML::Format object. # sub copy { my $self = shift; my $other = $_[0]; return unless defined $other; return unless (ref($self) eq ref($other)); my $xf = $self->{_xf_index}; # Store XF index assigned by Workbook.pm my $palette = $self->{_palette}; # Store palette assigned by Workbook.pm %$self = %$other; # Copy properties $self->{_xf_index} = $xf; # Restore XF index $self->{_palette} = $palette; # Restore palette } ############################################################################### # # convert_to_html_color() # # Convert from an Excel internal colour index to a Html style #RRGGBB index # based on the default or user defined values in the Workbook palette. # sub convert_to_html_color { my $self = shift; my $index = $_[0]; return 0 unless $index; $index -=8; # Adjust colour index # _palette is a reference to the colour palette in the Workbook module my @rgb = @{${$self->{_palette}}->[$index]}[0,1,2]; return sprintf "#%02X%02X%02X", @rgb; } ############################################################################### # # get_align_properties() # # Return properties for an Excel XML element. # # Excels handling of the vertical align "Bottom" property is different from # other properties. It is on by default if any non-vertical property is set. # Therefore we set the undefined _text_v_align value to -1 so that we can # detect if it has been set by the user. If it hasn't been set then we supply # the default "Bottom" value. # # sub get_align_properties { my $self = shift; my @align; # Attributes to return # Check if any alignment options in the format have been changed. my $changed = ( $self->{_text_h_align} != 0 || $self->{_text_v_align} != -1 || $self->{_indent} != 0 || $self->{_rotation} != 0 || $self->{_text_vertical} != 0 || $self->{_text_wrap} != 0 || $self->{_shrink} != 0 || $self->{_reading_order} != 0) ? 1 : 0; return unless $changed; # Excel sets 'ss:Vertical="Bottom"' even when it is the default. $self->{_text_v_align} = 2 if $self->{_text_v_align} == -1; # Check for properties that are mutually exclusive. $self->{_rotation} = 0 if $self->{_text_vertical}; $self->{_shrink} = 0 if $self->{_text_wrap}; $self->{_shrink} = 0 if $self->{_text_h_align} == 4; # Fill $self->{_shrink} = 0 if $self->{_text_h_align} == 5; # Justify $self->{_shrink} = 0 if $self->{_text_h_align} == 7; # Distributed $self->{_just_distrib} = 0 if $self->{_text_h_align} != 7; # Distributed TODO push @align, 'ss:Horizontal', 'Left' if $self->{_text_h_align} == 1; push @align, 'ss:Horizontal', 'Center' if $self->{_text_h_align} == 2; push @align, 'ss:Horizontal', 'Right' if $self->{_text_h_align} == 3; push @align, 'ss:Horizontal', 'Fill' if $self->{_text_h_align} == 4; push @align, 'ss:Horizontal', 'Justify' if $self->{_text_h_align} == 5; push @align, 'ss:Horizontal', 'CenterAcrossSelection' if $self->{_text_h_align} == 6; push @align, 'ss:Horizontal', 'Distributed' if $self->{_text_h_align} == 7; push @align, 'ss:Vertical', 'Top' if $self->{_text_v_align} == 0; push @align, 'ss:Vertical', 'Center' if $self->{_text_v_align} == 1; push @align, 'ss:Vertical', 'Bottom' if $self->{_text_v_align} == 2; push @align, 'ss:Vertical', 'Justify' if $self->{_text_v_align} == 3; push @align, 'ss:Vertical', 'Distributed' if $self->{_text_v_align} == 4; push @align, 'ss:Indent', $self->{_indent} if $self->{_indent}; push @align, 'ss:Rotate', $self->{_rotation} if $self->{_rotation}; push @align, 'ss:VerticalText',1 if $self->{_text_vertical}; push @align, 'ss:WrapText', 1 if $self->{_text_wrap}; push @align, 'ss:ShrinkToFit', 1 if $self->{_shrink}; # 'Context' is default property for ReadingOrder. push @align, 'ss:ReadingOrder','LeftToRight' if $self->{_reading_order}==1; push @align, 'ss:ReadingOrder','RightToLeft' if $self->{_reading_order}==2; # TODO # ss:Horizontal="JustifyDistributed" ss:Vertical="Bottom" return @align; } ############################################################################### # # get_border_properties() # # Return properties for an Excel XML element. # sub get_border_properties { my $self = shift; my @border; # Attributes to return my %linetypes =( 1 => ['ss:LineStyle' => 'Continuous', 'ss:Weight' => 1], 2 => ['ss:LineStyle' => 'Continuous', 'ss:Weight' => 2], 3 => ['ss:LineStyle' => 'Dash', 'ss:Weight' => 1], 4 => ['ss:LineStyle' => 'Dot', 'ss:Weight' => 1], 5 => ['ss:LineStyle' => 'Continuous', 'ss:Weight' => 3], 6 => ['ss:LineStyle' => 'Double', 'ss:Weight' => 3], 7 => ['ss:LineStyle' => 'Continuous' ], 8 => ['ss:LineStyle' => 'Dash', 'ss:Weight' => 2], 9 => ['ss:LineStyle' => 'DashDot', 'ss:Weight' => 1], 10 => ['ss:LineStyle' => 'DashDot', 'ss:Weight' => 2], 11 => ['ss:LineStyle' => 'DashDotDot', 'ss:Weight' => 1], 12 => ['ss:LineStyle' => 'DashDotDot', 'ss:Weight' => 2], 13 => ['ss:LineStyle' => 'SlantDashDot', 'ss:Weight' => 2], ); for my $position ('_bottom', '_left', '_right', '_top') { (my $type = $position) =~ s/^_//; my @attribs = ('ss:Position', ucfirst $type); my $position_color = $position . '_color'; if (exists $linetypes{$self->{$position}}) { push @attribs, @{$linetypes{$self->{$position}}}; if (my $color = $self->{$position_color}) { $color = $self->convert_to_html_color($color); push @attribs, 'ss:Color', $color; } push @border, [@attribs]; } } # Handle diagonal borders. Note that in Excel it is only possible to have # one line type and one colour when both diagonals are in use. if (my $diag_type = $self->{_diag_type}) { # Set a default diagonal border style if none was specified. $self->{_diag_border} = 1 if not $self->{_diag_border}; my @attribs = @{$linetypes{$self->{_diag_border}}}; if (my $color = $self->{_diag_color}) { $color = $self->convert_to_html_color($color); push @attribs, 'ss:Color', $color; } if ($diag_type == 1 or $diag_type == 3) { push @border, ["ss:Position", "DiagonalLeft", @attribs]; } if ($diag_type == 2 or $diag_type == 3) { push @border, ["ss:Position", "DiagonalRight", @attribs]; } } return @border; } ############################################################################### # # get_font_properties() # # Return properties for an Excel XML element. # sub get_font_properties { my $self = shift; my @font; # Attributes to return my $color = $self->convert_to_html_color($self->{_color}); push @font, 'ss:FontName', $self->{_font} if $self->{_font} ne 'Arial'; push @font, 'ss:Size', $self->{_size} if $self->{_size} != 10; push @font, 'ss:Color', $color if $self->{_color}; push @font, 'ss:Bold', 1 if $self->{_bold}; push @font, 'ss:Italic', 1 if $self->{_italic}; push @font, 'ss:StrikeThrough', 1 if $self->{_font_strikeout}; push @font, 'ss:Outline', 1 if $self->{_font_outline}; push @font, 'ss:Shadow', 1 if $self->{_font_shadow}; push @font, 'ss:VerticalAlign', 'Superscript' if $self->{_font_script} == 1; push @font, 'ss:VerticalAlign', 'Subscript' if $self->{_font_script} == 2; push @font, 'ss:Underline', 'Single' if $self->{_underline} == 1; push @font, 'ss:Underline', 'Double' if $self->{_underline} == 2; push @font, 'ss:Underline', 'SingleAccounting'if $self->{_underline} == 33; push @font, 'ss:Underline', 'DoubleAccounting'if $self->{_underline} == 34; push @font, 'x:Family', $self->{_font_family} if $self->{_font_family}; push @font, 'x:CharSet', $self->{_font_charset} if $self->{_font_charset}; return @font; } ############################################################################### # # get_interior_properties() # # Return properties for an Excel XML element. # sub get_interior_properties { my $self = shift; # Return undef if the background and foreground colours haven't been set # and the pattern hasn't been set or if it has only been set to solid. # Other patterns will be handled with the default colours. # return if $self->{_fg_color} == 0x00 and $self->{_bg_color} == 0x00 and $self->{_pattern} <= 0x01; # Note for XML: # ss:Color = _bg_color # ss:PatternColor = _fg_color # The following logical statements take care of special cases in relation # to cell colours and patterns: # 1. For a solid fill (_pattern == 1) Excel reverses the role of foreground # and background colours. # 2. If the user specifies a foreground or background colour without a # pattern they probably wanted a solid fill, so we fill in the defaults. # if ($self->{_pattern} <= 0x01) { if ($self->{_bg_color}) { return 'ss:Color', $self->convert_to_html_color($self->{_bg_color}), 'ss:Pattern', 'Solid'; } else { return 'ss:Color', $self->convert_to_html_color($self->{_fg_color}), 'ss:Pattern', 'Solid'; } } # Set default colours if they haven't been set. $self->{_bg_color} = 0x09 if $self->{_bg_color} == 0x00; # 0x09 = white $self->{_fg_color} = 0x08 if $self->{_fg_color} == 0x00; # 0x08 = black my %patterns = ( 1 => 'Solid', 2 => 'Gray50', 3 => 'Gray75', 4 => 'Gray25', 5 => 'HorzStripe', 6 => 'VertStripe', 7 => 'ReverseDiagStripe', 8 => 'DiagStripe', 9 => 'DiagCross', 10 => 'ThickDiagCross', 11 => 'ThinHorzStripe', 12 => 'ThinVertStripe', 13 => 'ThinReverseDiagStripe', 14 => 'ThinDiagStripe', 15 => 'ThinHorzCross', 16 => 'ThinDiagCross', 17 => 'Gray125', 18 => 'Gray0625', ); return unless exists $patterns{$self->{_pattern}}; return 'ss:Color', $self->convert_to_html_color($self->{_bg_color}), 'ss:Pattern', $patterns{$self->{_pattern}}, 'ss:PatternColor', $self->convert_to_html_color($self->{_fg_color}); } ############################################################################### # # get_num_format_properties() # # Return properties for an Excel XML element. # sub get_num_format_properties { my $self = shift; return unless defined $self->{_num_format}; # This hash is here mainly to cater for Spreadsheet::WriteExcel programs # and Excel files that use the in-built format codes. ExcelXML users # should specify the format explicitly. # my %num_format = ( 1 => '0', 2 => 'Fixed', 3 => '#,##0', 4 => 'Standard', 5 => '$#,##0;\-$#,##0', 6 => '$#,##0;[Red]\-$#,##0', 7 => '$#,##0.00;\-$#,##0.00', 8 => 'Currency', 9 => '0%', 10 => 'Percent', 11 => 'Scientific', 12 => '#\ ?/?', 13 => '#\ ??/??', 14 => 'Short Date', 15 => 'Medium Date', 16 => 'dd\-mmm', 17 => 'mmm\-yy', 18 => 'Medium Time', 19 => 'Long Time', 20 => 'Short Time', 21 => 'hh:mm:ss', 22 => 'General Date', 37 => '#,##0;\-#,##0', 38 => '#,##0;[Red]\-#,##0', 39 => '#,##0.00;\-#,##0.00', 40 => '#,##0.00;[Red]\-#,##0.00', 41 => '_-* #,##0_-;\-* #,##0_-;_-* "-"_-;_-@_-', 42 => '_-$* #,##0_-;\-$* #,##0_-;_-$* "-"_-;_-@_-', 43 => '_-* #,##0.00_-;\-* #,##0.00_-;_-* "-"??_-;_-@_-', 44 => '_-$* #,##0.00_-;\-$* #,##0.00_-;_-$* "-"??_-;_-@_-', 45 => 'mm:ss', 46 => '[h]:mm:ss', 47 => 'mm:ss.0', 48 => '##0.0E+0', 49 => '@', ); my $num_format; # Num_format is either a built-in code or a user specified string. if (exists $num_format{$self->{_num_format}}) { $num_format = $num_format{$self->{_num_format}}; } else { $num_format = $self->{_num_format}; } return 'ss:Format', $num_format; } ############################################################################### # # get_protection_properties() # # Return properties for an Excel XML element. # sub get_protection_properties { my $self = shift; my @attribs; # Attributes to return push @attribs, 'x:HideFormula', 1 if $self->{_hidden}; push @attribs, 'ss:Protected', 0 if not $self->{_locked}; return @attribs; } ############################################################################### # # get_xf_index() # # Returns the index used by Worksheet->_XF() # sub get_xf_index { my $self = shift; return $self->{_xf_index}; } ############################################################################### # # _get_color() # # Used in conjunction with the set_xxx_color methods to convert a color # string into a number. Color range is 0..63 but we will restrict it # to 8..63 to comply with Gnumeric. Colors 0..7 are repeated in 8..15. # sub _get_color { my %colors = ( aqua => 0x0F, cyan => 0x0F, black => 0x08, blue => 0x0C, brown => 0x10, magenta => 0x0E, fuchsia => 0x0E, gray => 0x17, grey => 0x17, green => 0x11, lime => 0x0B, navy => 0x12, orange => 0x35, purple => 0x14, red => 0x0A, silver => 0x16, white => 0x09, yellow => 0x0D, ); # Return the default color if undef, return 0x00 unless defined $_[0]; # or the color string converted to an integer, return $colors{lc($_[0])} if exists $colors{lc($_[0])}; # or the default color if string is unrecognised, return 0x00 if ($_[0] =~ m/\D/); # or an index < 8 mapped into the correct range, return $_[0] + 8 if $_[0] < 8; # or the default color if arg is outside range, return 0x00 if $_[0] > 63; # or an integer in the valid range return $_[0]; } ############################################################################### # # set_align() # # Set cell alignment. # sub set_align { my $self = shift; my $location = $_[0]; return if not defined $location; # No default return if $location =~ m/\d/; # Ignore numbers $location = lc($location); $self->set_text_h_align(1) if ($location eq 'left'); $self->set_text_h_align(2) if ($location eq 'centre'); $self->set_text_h_align(2) if ($location eq 'center'); $self->set_text_h_align(3) if ($location eq 'right'); $self->set_text_h_align(4) if ($location eq 'fill'); $self->set_text_h_align(5) if ($location eq 'justify'); $self->set_text_h_align(6) if ($location eq 'center_across'); $self->set_text_h_align(6) if ($location eq 'centre_across'); $self->set_text_h_align(6) if ($location eq 'merge'); # S:WE name $self->set_text_h_align(7) if ($location eq 'distributed'); $self->set_text_h_align(7) if ($location eq 'equal_space'); # ParseExcel $self->set_text_v_align(0) if ($location eq 'top'); $self->set_text_v_align(1) if ($location eq 'vcentre'); $self->set_text_v_align(1) if ($location eq 'vcenter'); $self->set_text_v_align(2) if ($location eq 'bottom'); $self->set_text_v_align(3) if ($location eq 'vjustify'); $self->set_text_v_align(4) if ($location eq 'vdistributed'); $self->set_text_v_align(4) if ($location eq 'vequal_space'); # ParseExcel } ############################################################################### # # set_valign() # # Set vertical cell alignment. This is required by the set_properties() method # to differentiate between the vertical and horizontal properties. # sub set_valign { my $self = shift; $self->set_align(@_); } ############################################################################### # # set_center_across() # # Implements the Excel5 style "merge". # sub set_center_across { my $self = shift; $self->set_text_h_align(6); } ############################################################################### # # set_merge() # # This was the way to implement a merge in Excel5. However it should have been # called "center_across" and not "merge". # This is now deprecated. Use set_center_across() or better merge_range(). # # sub set_merge { my $self = shift; $self->set_text_h_align(6); } ############################################################################### # # set_bold() # # Unlike the binary format in Spreadsheet::WriteExcel bold cannot have a # "weight". In the XML format it is either on or off. # sub set_bold { my $self = shift; my $bold = shift; $bold = 1 if not defined $bold; $self->{_bold} = $bold ? 1 : 0; } ############################################################################### # # set_border($style) # # Set cells borders to the same style # sub set_border { my $self = shift; my $style = $_[0]; $self->set_bottom($style); $self->set_top($style); $self->set_left($style); $self->set_right($style); } ############################################################################### # # set_border_color($color) # # Set cells border to the same color # sub set_border_color { my $self = shift; my $color = $_[0]; $self->set_bottom_color($color); $self->set_top_color($color); $self->set_left_color($color); $self->set_right_color($color); } ############################################################################### # # set_rotation($angle) # # Set the rotation angle of the text. An alignment property. # sub set_rotation { my $self = shift; my $rotation = $_[0]; # Argument should be a number return if $rotation !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; # The arg type can be a double but the Excel dialog only allows integers. $rotation = int $rotation; if ($rotation == 270) { # Special case inherited from the S::WE interface. $self->{_text_vertical} = 1; $self->{_rotation} = 0; return } elsif ($rotation < -90 or $rotation > 90) { carp "Rotation $rotation outside range: -90 <= angle <= 90"; $self->{_rotation} = 0; return; } # Rotation and vertical text are mutually exclusive $self->{_text_vertical} = 0; $self->{_rotation} = $rotation; } ############################################################################### # # set_properties() # # Convert hashes of properties to method calls. # sub set_properties { my $self = shift; my %properties = @_; # Merge multiple hashes into one while (my($key, $value) = each(%properties)) { # Strip leading "-" from Tk style properties eg. -color => 'red'. $key =~ s/^-//; # Make sure method names are alphanumeric characters only, in case # tainted data is passed to the eval(). # die "Unknown method: \$self->set_$key\n" if $key =~ /\W/; # Evaling $value as a string gets around the problem of some # numerical format strings being evaluated as numbers, for example # "00000" for a zip code. # if (defined $value) { eval "\$self->set_$key('$value')"; } else { eval "\$self->set_$key(undef)"; } die $@ if $@; # Re-throw the eval error. } } ############################################################################### # # AUTOLOAD. Deus ex machina. # # Dynamically create set methods that aren't already defined. # sub AUTOLOAD { my $self = shift; # Ignore calls to DESTROY return if $AUTOLOAD =~ /::DESTROY$/; # Check for a valid method names, ie. "set_xxx_yyy". $AUTOLOAD =~ /.*::set(\w+)/ or die "Unknown method: $AUTOLOAD\n"; # Match the attribute, ie. "_xxx_yyy". my $attribute = $1; # Check that the attribute exists exists $self->{$attribute} or die "Unknown method: $AUTOLOAD\n"; # The attribute value my $value; # There are two types of set methods: set_property() and # set_property_color(). When a method is AUTOLOADED we store a new anonymous # sub in the appropriate slot in the symbol table. The speeds up subsequent # calls to the same method. # no strict 'refs'; # To allow symbol table hackery if ($AUTOLOAD =~ /.*::set\w+color$/) { # For "set_property_color" methods $value = _get_color($_[0]); *{$AUTOLOAD} = sub { my $self = shift; $self->{$attribute} = _get_color($_[0]); }; } else { $value = $_[0]; $value = 1 if not defined $value; # The default value is always 1 *{$AUTOLOAD} = sub { my $self = shift; my $value = shift; $value = 1 if not defined $value; $self->{$attribute} = $value; }; } $self->{$attribute} = $value; } 1; __END__ =head1 NAME Format - A class for defining Excel formatting. =head1 SYNOPSIS See the documentation for Spreadsheet::WriteExcelXML =head1 DESCRIPTION This module is used in conjunction with Spreadsheet::WriteExcelXML. =head1 AUTHOR John McNamara jmcnamara@cpan.org =head1 PATENT LICENSE Software programs that read or write files that comply with the Microsoft specifications for the Office Schemas must include the following notice: "This product may incorporate intellectual property owned by Microsoft Corporation. The terms and conditions upon which Microsoft is licensing such intellectual property may be found at http://msdn.microsoft.com/library/en-us/odcXMLRef/html/odcXMLRefLegalNotice.asp." =head1 COPYRIGHT © MM-MMXI, John McNamara. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.