1package Excel::Writer::XLSX::Format; 2 3############################################################################### 4# 5# Format - A class for defining Excel formatting. 6# 7# 8# Used in conjunction with Excel::Writer::XLSX 9# 10# Copyright 2000-2021, John McNamara, jmcnamara@cpan.org 11# 12# Documentation after __END__ 13# 14 15use 5.008002; 16use Exporter; 17use strict; 18use warnings; 19use Carp; 20 21 22our @ISA = qw(Exporter); 23our $VERSION = '1.09'; 24our $AUTOLOAD; 25 26 27############################################################################### 28# 29# new() 30# 31# Constructor 32# 33sub new { 34 35 my $class = shift; 36 37 my $self = { 38 _xf_format_indices => shift, 39 _dxf_format_indices => shift, 40 _xf_index => undef, 41 _dxf_index => undef, 42 43 _num_format => 'General', 44 _num_format_index => 0, 45 _font_index => 0, 46 _has_font => 0, 47 _has_dxf_font => 0, 48 _font => 'Calibri', 49 _size => 11, 50 _bold => 0, 51 _italic => 0, 52 _color => 0x0, 53 _underline => 0, 54 _font_strikeout => 0, 55 _font_outline => 0, 56 _font_shadow => 0, 57 _font_script => 0, 58 _font_family => 2, 59 _font_charset => 0, 60 _font_scheme => 'minor', 61 _font_condense => 0, 62 _font_extend => 0, 63 _theme => 0, 64 _hyperlink => 0, 65 _xf_id => 0, 66 67 _hidden => 0, 68 _locked => 1, 69 70 _text_h_align => 0, 71 _text_wrap => 0, 72 _text_v_align => 0, 73 _text_justlast => 0, 74 _rotation => 0, 75 76 _fg_color => 0x00, 77 _bg_color => 0x00, 78 _pattern => 0, 79 _has_fill => 0, 80 _has_dxf_fill => 0, 81 _fill_index => 0, 82 _fill_count => 0, 83 84 _border_index => 0, 85 _has_border => 0, 86 _has_dxf_border => 0, 87 _border_count => 0, 88 89 _bottom => 0, 90 _bottom_color => 0x0, 91 _diag_border => 0, 92 _diag_color => 0x0, 93 _diag_type => 0, 94 _left => 0, 95 _left_color => 0x0, 96 _right => 0, 97 _right_color => 0x0, 98 _top => 0, 99 _top_color => 0x0, 100 101 _indent => 0, 102 _shrink => 0, 103 _merge_range => 0, 104 _reading_order => 0, 105 _just_distrib => 0, 106 _color_indexed => 0, 107 _font_only => 0, 108 109 }; 110 111 bless $self, $class; 112 113 # Set properties passed to Workbook::add_format() 114 $self->set_format_properties(@_) if @_; 115 116 return $self; 117} 118 119 120############################################################################### 121# 122# copy($format) 123# 124# Copy the attributes of another Excel::Writer::XLSX::Format object. 125# 126sub copy { 127 my $self = shift; 128 my $other = $_[0]; 129 130 131 return unless defined $other; 132 return unless ( ref( $self ) eq ref( $other ) ); 133 134 # Store properties that we don't want over-ridden. 135 my $xf_index = $self->{_xf_index}; 136 my $dxf_index = $self->{_dxf_index}; 137 my $xf_format_indices = $self->{_xf_format_indices}; 138 my $dxf_format_indices = $self->{_dxf_format_indices}; 139 my $palette = $self->{_palette}; 140 141 # Copy properties. 142 %$self = %$other; 143 144 # Restore original properties. 145 $self->{_xf_index} = $xf_index; 146 $self->{_dxf_index} = $dxf_index; 147 $self->{_xf_format_indices} = $xf_format_indices; 148 $self->{_dxf_format_indices} = $dxf_format_indices; 149 $self->{_palette} = $palette; 150} 151 152 153############################################################################### 154# 155# get_align_properties() 156# 157# Return properties for an Style xf <alignment> sub-element. 158# 159sub get_align_properties { 160 161 my $self = shift; 162 163 my @align; # Attributes to return 164 165 # Check if any alignment options in the format have been changed. 166 my $changed = 167 ( $self->{_text_h_align} != 0 168 || $self->{_text_v_align} != 0 169 || $self->{_indent} != 0 170 || $self->{_rotation} != 0 171 || $self->{_text_wrap} != 0 172 || $self->{_shrink} != 0 173 || $self->{_reading_order} != 0 ) ? 1 : 0; 174 175 return unless $changed; 176 177 178 179 # Indent is only allowed for horizontal left, right and distributed. If it 180 # is defined for any other alignment or no alignment has been set then 181 # default to left alignment. 182 if ( $self->{_indent} 183 && $self->{_text_h_align} != 1 184 && $self->{_text_h_align} != 3 185 && $self->{_text_h_align} != 7 ) 186 { 187 $self->{_text_h_align} = 1; 188 } 189 190 # Check for properties that are mutually exclusive. 191 $self->{_shrink} = 0 if $self->{_text_wrap}; 192 $self->{_shrink} = 0 if $self->{_text_h_align} == 4; # Fill 193 $self->{_shrink} = 0 if $self->{_text_h_align} == 5; # Justify 194 $self->{_shrink} = 0 if $self->{_text_h_align} == 7; # Distributed 195 $self->{_just_distrib} = 0 if $self->{_text_h_align} != 7; # Distributed 196 $self->{_just_distrib} = 0 if $self->{_indent}; 197 198 my $continuous = 'centerContinuous'; 199 200 push @align, 'horizontal', 'left' if $self->{_text_h_align} == 1; 201 push @align, 'horizontal', 'center' if $self->{_text_h_align} == 2; 202 push @align, 'horizontal', 'right' if $self->{_text_h_align} == 3; 203 push @align, 'horizontal', 'fill' if $self->{_text_h_align} == 4; 204 push @align, 'horizontal', 'justify' if $self->{_text_h_align} == 5; 205 push @align, 'horizontal', $continuous if $self->{_text_h_align} == 6; 206 push @align, 'horizontal', 'distributed' if $self->{_text_h_align} == 7; 207 208 push @align, 'justifyLastLine', 1 if $self->{_just_distrib}; 209 210 # Property 'vertical' => 'bottom' is a default. It sets applyAlignment 211 # without an alignment sub-element. 212 push @align, 'vertical', 'top' if $self->{_text_v_align} == 1; 213 push @align, 'vertical', 'center' if $self->{_text_v_align} == 2; 214 push @align, 'vertical', 'justify' if $self->{_text_v_align} == 4; 215 push @align, 'vertical', 'distributed' if $self->{_text_v_align} == 5; 216 217 push @align, 'indent', $self->{_indent} if $self->{_indent}; 218 push @align, 'textRotation', $self->{_rotation} if $self->{_rotation}; 219 220 push @align, 'wrapText', 1 if $self->{_text_wrap}; 221 push @align, 'shrinkToFit', 1 if $self->{_shrink}; 222 223 push @align, 'readingOrder', 1 if $self->{_reading_order} == 1; 224 push @align, 'readingOrder', 2 if $self->{_reading_order} == 2; 225 226 return $changed, @align; 227} 228 229 230############################################################################### 231# 232# get_protection_properties() 233# 234# Return properties for an Excel XML <Protection> element. 235# 236sub get_protection_properties { 237 238 my $self = shift; 239 240 my @attribs; 241 242 push @attribs, 'locked', 0 if !$self->{_locked}; 243 push @attribs, 'hidden', 1 if $self->{_hidden}; 244 245 return @attribs; 246} 247 248 249############################################################################### 250# 251# get_format_key() 252# 253# Returns a unique hash key for the Format object. 254# 255sub get_format_key { 256 257 my $self = shift; 258 259 my $key = join ':', 260 ( 261 $self->get_font_key(), $self->get_border_key, 262 $self->get_fill_key(), $self->get_alignment_key(), 263 $self->{_num_format}, $self->{_locked}, 264 $self->{_hidden} 265 ); 266 267 return $key; 268} 269 270############################################################################### 271# 272# get_font_key() 273# 274# Returns a unique hash key for a font. Used by Workbook. 275# 276sub get_font_key { 277 278 my $self = shift; 279 280 my $key = join ':', ( 281 $self->{_bold}, 282 $self->{_color}, 283 $self->{_font_charset}, 284 $self->{_font_family}, 285 $self->{_font_outline}, 286 $self->{_font_script}, 287 $self->{_font_shadow}, 288 $self->{_font_strikeout}, 289 $self->{_font}, 290 $self->{_italic}, 291 $self->{_size}, 292 $self->{_underline}, 293 $self->{_theme}, 294 295 ); 296 297 return $key; 298} 299 300 301############################################################################### 302# 303# get_border_key() 304# 305# Returns a unique hash key for a border style. Used by Workbook. 306# 307sub get_border_key { 308 309 my $self = shift; 310 311 my $key = join ':', ( 312 $self->{_bottom}, 313 $self->{_bottom_color}, 314 $self->{_diag_border}, 315 $self->{_diag_color}, 316 $self->{_diag_type}, 317 $self->{_left}, 318 $self->{_left_color}, 319 $self->{_right}, 320 $self->{_right_color}, 321 $self->{_top}, 322 $self->{_top_color}, 323 324 ); 325 326 return $key; 327} 328 329 330############################################################################### 331# 332# get_fill_key() 333# 334# Returns a unique hash key for a fill style. Used by Workbook. 335# 336sub get_fill_key { 337 338 my $self = shift; 339 340 my $key = join ':', ( 341 $self->{_pattern}, 342 $self->{_bg_color}, 343 $self->{_fg_color}, 344 345 ); 346 347 return $key; 348} 349 350 351############################################################################### 352# 353# get_alignment_key() 354# 355# Returns a unique hash key for alignment formats. 356# 357sub get_alignment_key { 358 359 my $self = shift; 360 361 my $key = join ':', ( 362 $self->{_text_h_align}, 363 $self->{_text_v_align}, 364 $self->{_indent}, 365 $self->{_rotation}, 366 $self->{_text_wrap}, 367 $self->{_shrink}, 368 $self->{_reading_order}, 369 370 ); 371 372 return $key; 373} 374 375 376############################################################################### 377# 378# get_xf_index() 379# 380# Returns the index used by Worksheet->_XF() 381# 382sub get_xf_index { 383 my $self = shift; 384 385 if ( defined $self->{_xf_index} ) { 386 return $self->{_xf_index}; 387 } 388 else { 389 my $key = $self->get_format_key(); 390 my $indices_href = ${ $self->{_xf_format_indices} }; 391 392 if ( exists $indices_href->{$key} ) { 393 return $indices_href->{$key}; 394 } 395 else { 396 my $index = 1 + scalar keys %$indices_href; 397 $indices_href->{$key} = $index; 398 $self->{_xf_index} = $index; 399 return $index; 400 } 401 } 402} 403 404 405############################################################################### 406# 407# get_dxf_index() 408# 409# Returns the index used by Worksheet->_XF() 410# 411sub get_dxf_index { 412 my $self = shift; 413 414 if ( defined $self->{_dxf_index} ) { 415 return $self->{_dxf_index}; 416 } 417 else { 418 my $key = $self->get_format_key(); 419 my $indices_href = ${ $self->{_dxf_format_indices} }; 420 421 if ( exists $indices_href->{$key} ) { 422 return $indices_href->{$key}; 423 } 424 else { 425 my $index = scalar keys %$indices_href; 426 $indices_href->{$key} = $index; 427 $self->{_dxf_index} = $index; 428 return $index; 429 } 430 } 431} 432 433 434############################################################################### 435# 436# _get_color() 437# 438# Used in conjunction with the set_xxx_color methods to convert a color 439# string into a number. Color range is 0..63 but we will restrict it 440# to 8..63 to comply with Gnumeric. Colors 0..7 are repeated in 8..15. 441# 442sub _get_color { 443 444 my %colors = ( 445 aqua => 0x0F, 446 cyan => 0x0F, 447 black => 0x08, 448 blue => 0x0C, 449 brown => 0x10, 450 magenta => 0x0E, 451 fuchsia => 0x0E, 452 gray => 0x17, 453 grey => 0x17, 454 green => 0x11, 455 lime => 0x0B, 456 navy => 0x12, 457 orange => 0x35, 458 pink => 0x21, 459 purple => 0x14, 460 red => 0x0A, 461 silver => 0x16, 462 white => 0x09, 463 yellow => 0x0D, 464 ); 465 466 # Return the default color if undef, 467 return 0x00 unless defined $_[0]; 468 469 # Return RGB style colors for processing later. 470 if ( $_[0] =~ m/^#[0-9A-F]{6}$/i ) { 471 return $_[0]; 472 } 473 474 # or the color string converted to an integer, 475 return $colors{ lc( $_[0] ) } if exists $colors{ lc( $_[0] ) }; 476 477 # or the default color if string is unrecognised, 478 return 0x00 if ( $_[0] =~ m/\D/ ); 479 480 # or an index < 8 mapped into the correct range, 481 return $_[0] + 8 if $_[0] < 8; 482 483 # or the default color if arg is outside range, 484 return 0x00 if $_[0] > 63; 485 486 # or an integer in the valid range 487 return $_[0]; 488} 489 490 491############################################################################### 492# 493# set_type() 494# 495# Set the XF object type as 0 = cell XF or 0xFFF5 = style XF. 496# 497sub set_type { 498 499 my $self = shift; 500 my $type = $_[0]; 501 502 if (defined $_[0] and $_[0] eq 0) { 503 $self->{_type} = 0x0000; 504 } 505 else { 506 $self->{_type} = 0xFFF5; 507 } 508} 509 510 511############################################################################### 512# 513# set_align() 514# 515# Set cell alignment. 516# 517sub set_align { 518 519 my $self = shift; 520 my $location = $_[0]; 521 522 return if not defined $location; # No default 523 return if $location =~ m/\d/; # Ignore numbers 524 525 $location = lc( $location ); 526 527 $self->set_text_h_align( 1 ) if $location eq 'left'; 528 $self->set_text_h_align( 2 ) if $location eq 'centre'; 529 $self->set_text_h_align( 2 ) if $location eq 'center'; 530 $self->set_text_h_align( 3 ) if $location eq 'right'; 531 $self->set_text_h_align( 4 ) if $location eq 'fill'; 532 $self->set_text_h_align( 5 ) if $location eq 'justify'; 533 $self->set_text_h_align( 6 ) if $location eq 'center_across'; 534 $self->set_text_h_align( 6 ) if $location eq 'centre_across'; 535 $self->set_text_h_align( 6 ) if $location eq 'merge'; # Legacy. 536 $self->set_text_h_align( 7 ) if $location eq 'distributed'; 537 $self->set_text_h_align( 7 ) if $location eq 'equal_space'; # S::PE. 538 $self->set_text_h_align( 7 ) if $location eq 'justify_distributed'; 539 540 $self->{_just_distrib} = 1 if $location eq 'justify_distributed'; 541 542 $self->set_text_v_align( 1 ) if $location eq 'top'; 543 $self->set_text_v_align( 2 ) if $location eq 'vcentre'; 544 $self->set_text_v_align( 2 ) if $location eq 'vcenter'; 545 $self->set_text_v_align( 3 ) if $location eq 'bottom'; 546 $self->set_text_v_align( 4 ) if $location eq 'vjustify'; 547 $self->set_text_v_align( 5 ) if $location eq 'vdistributed'; 548 $self->set_text_v_align( 5 ) if $location eq 'vequal_space'; # S::PE. 549} 550 551 552############################################################################### 553# 554# set_valign() 555# 556# Set vertical cell alignment. This is required by the set_properties() method 557# to differentiate between the vertical and horizontal properties. 558# 559sub set_valign { 560 561 my $self = shift; 562 $self->set_align( @_ ); 563} 564 565 566############################################################################### 567# 568# set_center_across() 569# 570# Implements the Excel5 style "merge". 571# 572sub set_center_across { 573 574 my $self = shift; 575 576 $self->set_text_h_align( 6 ); 577} 578 579 580############################################################################### 581# 582# set_merge() 583# 584# This was the way to implement a merge in Excel5. However it should have been 585# called "center_across" and not "merge". 586# This is now deprecated. Use set_center_across() or better merge_range(). 587# 588# 589sub set_merge { 590 591 my $self = shift; 592 593 $self->set_text_h_align( 6 ); 594} 595 596 597############################################################################### 598# 599# set_bold() 600# 601# 602sub set_bold { 603 604 my $self = shift; 605 my $bold = defined $_[0] ? $_[0] : 1; 606 607 $self->{_bold} = $bold ? 1 : 0; 608} 609 610 611############################################################################### 612# 613# set_border($style) 614# 615# Set cells borders to the same style 616# 617sub set_border { 618 619 my $self = shift; 620 my $style = $_[0]; 621 622 $self->set_bottom( $style ); 623 $self->set_top( $style ); 624 $self->set_left( $style ); 625 $self->set_right( $style ); 626} 627 628 629############################################################################### 630# 631# set_border_color($color) 632# 633# Set cells border to the same color 634# 635sub set_border_color { 636 637 my $self = shift; 638 my $color = $_[0]; 639 640 $self->set_bottom_color( $color ); 641 $self->set_top_color( $color ); 642 $self->set_left_color( $color ); 643 $self->set_right_color( $color ); 644} 645 646 647############################################################################### 648# 649# set_rotation($angle) 650# 651# Set the rotation angle of the text. An alignment property. 652# 653sub set_rotation { 654 655 my $self = shift; 656 my $rotation = $_[0]; 657 658 # Argument should be a number 659 return if $rotation !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; 660 661 # The arg type can be a double but the Excel dialog only allows integers. 662 $rotation = int $rotation; 663 664 if ( $rotation == 270 ) { 665 $rotation = 255; 666 } 667 elsif ( $rotation >= -90 and $rotation <= 90 ) { 668 $rotation = -$rotation + 90 if $rotation < 0; 669 } 670 else { 671 carp "Rotation $rotation outside range: -90 <= angle <= 90"; 672 $rotation = 0; 673 } 674 675 $self->{_rotation} = $rotation; 676} 677 678 679############################################################################### 680# 681# set_hyperlink() 682# 683# Set the properties for the hyperlink style. This isn't a public method. To 684# be fixed when styles are supported. 685# 686sub set_hyperlink { 687 688 my $self = shift; 689 my $hyperlink = shift; 690 691 $self->{_xf_id} = 1; 692 693 $self->set_underline( 1 ); 694 $self->set_theme( 10 ); 695 $self->{_hyperlink} = $hyperlink; 696} 697 698 699############################################################################### 700# 701# set_format_properties() 702# 703# Convert hashes of properties to method calls. 704# 705sub set_format_properties { 706 707 my $self = shift; 708 709 my %properties = @_; # Merge multiple hashes into one 710 711 while ( my ( $key, $value ) = each( %properties ) ) { 712 713 # Strip leading "-" from Tk style properties e.g. -color => 'red'. 714 $key =~ s/^-//; 715 716 # Create a sub to set the property. 717 my $sub = \&{"set_$key"}; 718 $sub->( $self, $value ); 719 } 720} 721 722# Renamed rarely used set_properties() to set_format_properties() to avoid 723# confusion with Workbook method of the same name. The following acts as an 724# alias for any code that uses the old name. 725*set_properties = *set_format_properties; 726 727 728############################################################################### 729# 730# AUTOLOAD. Deus ex machina. 731# 732# Dynamically create set methods that aren't already defined. 733# 734sub AUTOLOAD { 735 736 my $self = shift; 737 738 # Ignore calls to DESTROY 739 return if $AUTOLOAD =~ /::DESTROY$/; 740 741 # Check for a valid method names, i.e. "set_xxx_yyy". 742 $AUTOLOAD =~ /.*::set(\w+)/ or die "Unknown method: $AUTOLOAD\n"; 743 744 # Match the attribute, i.e. "_xxx_yyy". 745 my $attribute = $1; 746 747 # Check that the attribute exists 748 exists $self->{$attribute} or die "Unknown method: $AUTOLOAD\n"; 749 750 # The attribute value 751 my $value; 752 753 754 # There are two types of set methods: set_property() and 755 # set_property_color(). When a method is AUTOLOADED we store a new anonymous 756 # sub in the appropriate slot in the symbol table. The speeds up subsequent 757 # calls to the same method. 758 # 759 no strict 'refs'; # To allow symbol table hackery 760 761 if ( $AUTOLOAD =~ /.*::set\w+color$/ ) { 762 763 # For "set_property_color" methods 764 $value = _get_color( $_[0] ); 765 766 *{$AUTOLOAD} = sub { 767 my $self = shift; 768 769 $self->{$attribute} = _get_color( $_[0] ); 770 }; 771 } 772 else { 773 774 $value = $_[0]; 775 $value = 1 if not defined $value; # The default value is always 1 776 777 *{$AUTOLOAD} = sub { 778 my $self = shift; 779 my $value = shift; 780 781 $value = 1 if not defined $value; 782 $self->{$attribute} = $value; 783 }; 784 } 785 786 787 $self->{$attribute} = $value; 788} 789 790 7911; 792 793 794__END__ 795 796 797=head1 NAME 798 799Format - A class for defining Excel formatting. 800 801=head1 SYNOPSIS 802 803See the documentation for L<Excel::Writer::XLSX> 804 805=head1 DESCRIPTION 806 807This module is used in conjunction with L<Excel::Writer::XLSX>. 808 809=head1 AUTHOR 810 811John McNamara jmcnamara@cpan.org 812 813=head1 COPYRIGHT 814 815(c) MM-MMXXI, John McNamara. 816 817All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. 818