1package Excel::Writer::XLSX::Drawing; 2 3############################################################################### 4# 5# Drawing - A class for writing the Excel XLSX drawing.xml file. 6# 7# Used in conjunction with Excel::Writer::XLSX 8# 9# Copyright 2000-2021, John McNamara, jmcnamara@cpan.org 10# 11# Documentation after __END__ 12# 13 14# perltidy with the following options: -mbl=2 -pt=0 -nola 15 16use 5.008002; 17use strict; 18use warnings; 19use Carp; 20use Excel::Writer::XLSX::Package::XMLwriter; 21use Excel::Writer::XLSX::Worksheet; 22 23our @ISA = qw(Excel::Writer::XLSX::Package::XMLwriter); 24our $VERSION = '1.09'; 25 26 27############################################################################### 28# 29# Public and private API methods. 30# 31############################################################################### 32 33 34############################################################################### 35# 36# new() 37# 38# Constructor. 39# 40sub new { 41 42 my $class = shift; 43 my $fh = shift; 44 my $self = Excel::Writer::XLSX::Package::XMLwriter->new( $fh ); 45 46 $self->{_drawings} = []; 47 $self->{_embedded} = 0; 48 $self->{_orientation} = 0; 49 50 bless $self, $class; 51 52 return $self; 53} 54 55 56############################################################################### 57# 58# _assemble_xml_file() 59# 60# Assemble and write the XML file. 61# 62sub _assemble_xml_file { 63 64 my $self = shift; 65 66 $self->xml_declaration; 67 68 # Write the xdr:wsDr element. 69 $self->_write_drawing_workspace(); 70 71 if ( $self->{_embedded} ) { 72 73 my $index = 0; 74 for my $drawing_object ( @{ $self->{_drawings} } ) { 75 # Write the xdr:twoCellAnchor element. 76 $self->_write_two_cell_anchor( ++$index, $drawing_object ); 77 } 78 } 79 else { 80 my $index = 0; 81 82 # Write the xdr:absoluteAnchor element. 83 $self->_write_absolute_anchor( ++$index ); 84 } 85 86 $self->xml_end_tag( 'xdr:wsDr' ); 87 88 # Close the XML writer filehandle. 89 $self->xml_get_fh()->close(); 90} 91 92 93############################################################################### 94# 95# _add_drawing_object() 96# 97# Add a chart, image or shape sub object to the drawing. 98# 99sub _add_drawing_object { 100 101 my $self = shift; 102 103 my $drawing_object = { 104 _type => undef, 105 _dimensions => [], 106 _width => 0, 107 _height => 0, 108 _description => undef, 109 _shape => undef, 110 _anchor => undef, 111 _rel_index => 0, 112 _url_rel_index => 0, 113 _tip => undef, 114 _decorative => undef, 115 }; 116 117 push @{ $self->{_drawings} }, $drawing_object; 118 119 return $drawing_object; 120} 121 122 123############################################################################### 124# 125# Internal methods. 126# 127############################################################################### 128 129 130############################################################################### 131# 132# XML writing methods. 133# 134############################################################################### 135 136 137############################################################################## 138# 139# _write_drawing_workspace() 140# 141# Write the <xdr:wsDr> element. 142# 143sub _write_drawing_workspace { 144 145 my $self = shift; 146 my $schema = 'http://schemas.openxmlformats.org/drawingml/'; 147 my $xmlns_xdr = $schema . '2006/spreadsheetDrawing'; 148 my $xmlns_a = $schema . '2006/main'; 149 150 my @attributes = ( 151 'xmlns:xdr' => $xmlns_xdr, 152 'xmlns:a' => $xmlns_a, 153 ); 154 155 $self->xml_start_tag( 'xdr:wsDr', @attributes ); 156} 157 158 159############################################################################## 160# 161# _write_two_cell_anchor() 162# 163# Write the <xdr:twoCellAnchor> element. 164# 165sub _write_two_cell_anchor { 166 167 my $self = shift; 168 my $index = shift; 169 my $drawing_object = shift; 170 171 my $type = $drawing_object->{_type}; 172 my $dimensions = $drawing_object->{_dimensions}; 173 my $col_from = $dimensions->[0]; 174 my $row_from = $dimensions->[1]; 175 my $col_from_offset = $dimensions->[2]; 176 my $row_from_offset = $dimensions->[3]; 177 my $col_to = $dimensions->[4]; 178 my $row_to = $dimensions->[5]; 179 my $col_to_offset = $dimensions->[6]; 180 my $row_to_offset = $dimensions->[7]; 181 my $col_absolute = $dimensions->[8]; 182 my $row_absolute = $dimensions->[9]; 183 my $width = $drawing_object->{_width}; 184 my $height = $drawing_object->{_height}; 185 my $description = $drawing_object->{_description}; 186 my $shape = $drawing_object->{_shape}; 187 my $anchor = $drawing_object->{_anchor}; 188 my $rel_index = $drawing_object->{_rel_index}; 189 my $url_rel_index = $drawing_object->{_url_rel_index}; 190 my $tip = $drawing_object->{_tip}; 191 my $decorative = $drawing_object->{_decorative}; 192 193 my @attributes = (); 194 195 # Add attribute for images. 196 if ( $anchor == 2 ) { 197 push @attributes, ( editAs => 'oneCell' ); 198 } 199 elsif ( $anchor == 3 ) { 200 push @attributes, ( editAs => 'absolute' ); 201 } 202 203 # Add editAs attribute for shapes. 204 push @attributes, ( editAs => $shape->{_editAs} ) if $shape->{_editAs}; 205 206 $self->xml_start_tag( 'xdr:twoCellAnchor', @attributes ); 207 208 # Write the xdr:from element. 209 $self->_write_from( 210 $col_from, 211 $row_from, 212 $col_from_offset, 213 $row_from_offset, 214 215 ); 216 217 # Write the xdr:from element. 218 $self->_write_to( 219 $col_to, 220 $row_to, 221 $col_to_offset, 222 $row_to_offset, 223 224 ); 225 226 if ( $type == 1 ) { 227 228 # Graphic frame. 229 230 # Write the xdr:graphicFrame element for charts. 231 $self->_write_graphic_frame( $index, $rel_index, $description ); 232 } 233 elsif ( $type == 2 ) { 234 235 # Write the xdr:pic element. 236 $self->_write_pic( 237 $index, $rel_index, $col_absolute, $row_absolute, 238 $width, $height, $description, $url_rel_index, 239 $tip, $decorative 240 ); 241 } 242 else { 243 244 # Write the xdr:sp element for shapes. 245 $self->_write_sp( $index, $col_absolute, $row_absolute, $width, $height, 246 $shape ); 247 } 248 249 # Write the xdr:clientData element. 250 $self->_write_client_data(); 251 252 $self->xml_end_tag( 'xdr:twoCellAnchor' ); 253} 254 255 256############################################################################## 257# 258# _write_absolute_anchor() 259# 260# Write the <xdr:absoluteAnchor> element. 261# 262sub _write_absolute_anchor { 263 264 my $self = shift; 265 my $index = shift; 266 267 $self->xml_start_tag( 'xdr:absoluteAnchor' ); 268 269 # Different co-ordinates for horizonatal (= 0) and vertical (= 1). 270 if ( $self->{_orientation} == 0 ) { 271 272 # Write the xdr:pos element. 273 $self->_write_pos( 0, 0 ); 274 275 # Write the xdr:ext element. 276 $self->_write_xdr_ext( 9308969, 6078325 ); 277 278 } 279 else { 280 281 # Write the xdr:pos element. 282 $self->_write_pos( 0, -47625 ); 283 284 # Write the xdr:ext element. 285 $self->_write_xdr_ext( 6162675, 6124575 ); 286 287 } 288 289 290 # Write the xdr:graphicFrame element. 291 $self->_write_graphic_frame( $index, $index ); 292 293 # Write the xdr:clientData element. 294 $self->_write_client_data(); 295 296 $self->xml_end_tag( 'xdr:absoluteAnchor' ); 297} 298 299 300############################################################################## 301# 302# _write_from() 303# 304# Write the <xdr:from> element. 305# 306sub _write_from { 307 308 my $self = shift; 309 my $col = shift; 310 my $row = shift; 311 my $col_offset = shift; 312 my $row_offset = shift; 313 314 $self->xml_start_tag( 'xdr:from' ); 315 316 # Write the xdr:col element. 317 $self->_write_col( $col ); 318 319 # Write the xdr:colOff element. 320 $self->_write_col_off( $col_offset ); 321 322 # Write the xdr:row element. 323 $self->_write_row( $row ); 324 325 # Write the xdr:rowOff element. 326 $self->_write_row_off( $row_offset ); 327 328 $self->xml_end_tag( 'xdr:from' ); 329} 330 331 332############################################################################## 333# 334# _write_to() 335# 336# Write the <xdr:to> element. 337# 338sub _write_to { 339 340 my $self = shift; 341 my $col = shift; 342 my $row = shift; 343 my $col_offset = shift; 344 my $row_offset = shift; 345 346 $self->xml_start_tag( 'xdr:to' ); 347 348 # Write the xdr:col element. 349 $self->_write_col( $col ); 350 351 # Write the xdr:colOff element. 352 $self->_write_col_off( $col_offset ); 353 354 # Write the xdr:row element. 355 $self->_write_row( $row ); 356 357 # Write the xdr:rowOff element. 358 $self->_write_row_off( $row_offset ); 359 360 $self->xml_end_tag( 'xdr:to' ); 361} 362 363 364############################################################################## 365# 366# _write_col() 367# 368# Write the <xdr:col> element. 369# 370sub _write_col { 371 372 my $self = shift; 373 my $data = shift; 374 375 $self->xml_data_element( 'xdr:col', $data ); 376} 377 378 379############################################################################## 380# 381# _write_col_off() 382# 383# Write the <xdr:colOff> element. 384# 385sub _write_col_off { 386 387 my $self = shift; 388 my $data = shift; 389 390 $self->xml_data_element( 'xdr:colOff', $data ); 391} 392 393 394############################################################################## 395# 396# _write_row() 397# 398# Write the <xdr:row> element. 399# 400sub _write_row { 401 402 my $self = shift; 403 my $data = shift; 404 405 $self->xml_data_element( 'xdr:row', $data ); 406} 407 408 409############################################################################## 410# 411# _write_row_off() 412# 413# Write the <xdr:rowOff> element. 414# 415sub _write_row_off { 416 417 my $self = shift; 418 my $data = shift; 419 420 $self->xml_data_element( 'xdr:rowOff', $data ); 421} 422 423 424############################################################################## 425# 426# _write_pos() 427# 428# Write the <xdr:pos> element. 429# 430sub _write_pos { 431 432 my $self = shift; 433 my $x = shift; 434 my $y = shift; 435 436 my @attributes = ( 437 'x' => $x, 438 'y' => $y, 439 ); 440 441 $self->xml_empty_tag( 'xdr:pos', @attributes ); 442} 443 444 445############################################################################## 446# 447# _write_xdr_ext() 448# 449# Write the <xdr:ext> element. 450# 451sub _write_xdr_ext { 452 453 my $self = shift; 454 my $cx = shift; 455 my $cy = shift; 456 457 my @attributes = ( 458 'cx' => $cx, 459 'cy' => $cy, 460 ); 461 462 $self->xml_empty_tag( 'xdr:ext', @attributes ); 463} 464 465 466############################################################################## 467# 468# _write_graphic_frame() 469# 470# Write the <xdr:graphicFrame> element. 471# 472sub _write_graphic_frame { 473 474 my $self = shift; 475 my $index = shift; 476 my $rel_index = shift; 477 my $name = shift; 478 my $macro = ''; 479 480 my @attributes = ( 'macro' => $macro ); 481 482 $self->xml_start_tag( 'xdr:graphicFrame', @attributes ); 483 484 # Write the xdr:nvGraphicFramePr element. 485 $self->_write_nv_graphic_frame_pr( $index, $name ); 486 487 # Write the xdr:xfrm element. 488 $self->_write_xfrm(); 489 490 # Write the a:graphic element. 491 $self->_write_atag_graphic( $rel_index ); 492 493 $self->xml_end_tag( 'xdr:graphicFrame' ); 494} 495 496 497############################################################################## 498# 499# _write_nv_graphic_frame_pr() 500# 501# Write the <xdr:nvGraphicFramePr> element. 502# 503sub _write_nv_graphic_frame_pr { 504 505 my $self = shift; 506 my $index = shift; 507 my $name = shift; 508 509 if ( !$name ) { 510 $name = 'Chart ' . $index; 511 } 512 513 $self->xml_start_tag( 'xdr:nvGraphicFramePr' ); 514 515 # Write the xdr:cNvPr element. 516 $self->_write_c_nv_pr( $index + 1, $name ); 517 518 # Write the xdr:cNvGraphicFramePr element. 519 $self->_write_c_nv_graphic_frame_pr(); 520 521 $self->xml_end_tag( 'xdr:nvGraphicFramePr' ); 522} 523 524 525############################################################################## 526# 527# _write_c_nv_pr() 528# 529# Write the <xdr:cNvPr> element. 530# 531sub _write_c_nv_pr { 532 533 my $self = shift; 534 my $index = shift; 535 my $name = shift; 536 my $description = shift; 537 my $url_rel_index = shift; 538 my $tip = shift; 539 my $decorative = shift; 540 541 my @attributes = ( 542 'id' => $index, 543 'name' => $name, 544 ); 545 546 # Add description attribute for images. 547 if ($description && !$decorative) { 548 push @attributes, ( descr => $description ); 549 } 550 551 if ( $url_rel_index || $decorative ) { 552 $self->xml_start_tag( 'xdr:cNvPr', @attributes ); 553 554 if ($url_rel_index) { 555 # Write the a:hlinkClick element. 556 $self->_write_a_hlink_click( $url_rel_index, $tip ); 557 } 558 559 if ($decorative) { 560 # Write the adec:decorative element. 561 $self->_write_decorative(); 562 } 563 564 $self->xml_end_tag( 'xdr:cNvPr' ); 565 } 566 else { 567 $self->xml_empty_tag( 'xdr:cNvPr', @attributes ); 568 } 569} 570 571 572############################################################################## 573# 574# _write_a_hlink_click() 575# 576# Write the <a:hlinkClick> element. 577# 578sub _write_a_hlink_click { 579 580 my $self = shift; 581 my $index = shift; 582 my $tip = shift; 583 my $schema = 'http://schemas.openxmlformats.org/officeDocument/'; 584 my $xmlns_r = $schema . '2006/relationships'; 585 my $r_id = 'rId' . $index; 586 587 my @attributes = ( 588 'xmlns:r' => $xmlns_r, 589 'r:id' => $r_id, 590 ); 591 592 push( @attributes, ( 'tooltip' => $tip ) ) if $tip; 593 594 $self->xml_empty_tag('a:hlinkClick', @attributes ); 595} 596 597 598############################################################################## 599# 600# _write_decorative() 601# 602# Write the <adec:decorative> element. 603# 604sub _write_decorative { 605 606 my $self = shift; 607 608 609 $self->xml_start_tag( 'a:extLst' ); 610 611 $self->_write_a_uri_ext( '{FF2B5EF4-FFF2-40B4-BE49-F238E27FC236}' ); 612 $self->_write_a16_creation_id(); 613 $self->xml_end_tag( 'a:ext' ); 614 615 $self->_write_a_uri_ext( '{C183D7F6-B498-43B3-948B-1728B52AA6E4}' ); 616 $self->_write_adec_decorative(); 617 $self->xml_end_tag( 'a:ext' ); 618 619 $self->xml_end_tag( 'a:extLst' ); 620} 621 622############################################################################## 623# 624# _write_a_uri_ext() 625# 626# Write the <a:ext> element. 627# 628sub _write_a_uri_ext { 629 630 my $self = shift; 631 my $uri = shift; 632 633 my @attributes = ( 'uri' => $uri ); 634 635 $self->xml_start_tag( 'a:ext', @attributes ); 636} 637 638############################################################################## 639# 640# _write_adec_decorative() 641# 642# Write the <adec:decorative> element. 643# 644sub _write_adec_decorative { 645 646 my $self = shift; 647 my $xmlns_adec = 'http://schemas.microsoft.com/office/' . 648 'drawing/2017/decorative'; 649 my $val = 1; 650 651 my @attributes = ( 652 'xmlns:adec' => $xmlns_adec, 653 'val' => $val, 654 ); 655 656 $self->xml_empty_tag( 'adec:decorative', @attributes ); 657} 658 659############################################################################## 660# 661# _write_a16_creation_id() 662# 663# Write the <a16:creationId> element. 664# 665sub _write_a16_creation_id { 666 667 my $self = shift; 668 my $xmlns_a_16 = 'http://schemas.microsoft.com/office/drawing/2014/main'; 669 my $id = '{00000000-0008-0000-0000-000002000000}'; 670 671 my @attributes = ( 672 'xmlns:a16' => $xmlns_a_16, 673 'id' => $id, 674 ); 675 676 $self->xml_empty_tag( 'a16:creationId', @attributes ); 677} 678 679############################################################################## 680# 681# _write_c_nv_graphic_frame_pr() 682# 683# Write the <xdr:cNvGraphicFramePr> element. 684# 685sub _write_c_nv_graphic_frame_pr { 686 687 my $self = shift; 688 689 if ( $self->{_embedded} ) { 690 $self->xml_empty_tag( 'xdr:cNvGraphicFramePr' ); 691 } 692 else { 693 $self->xml_start_tag( 'xdr:cNvGraphicFramePr' ); 694 695 # Write the a:graphicFrameLocks element. 696 $self->_write_a_graphic_frame_locks(); 697 698 $self->xml_end_tag( 'xdr:cNvGraphicFramePr' ); 699 } 700} 701 702 703############################################################################## 704# 705# _write_a_graphic_frame_locks() 706# 707# Write the <a:graphicFrameLocks> element. 708# 709sub _write_a_graphic_frame_locks { 710 711 my $self = shift; 712 my $no_grp = 1; 713 714 my @attributes = ( 'noGrp' => $no_grp ); 715 716 $self->xml_empty_tag( 'a:graphicFrameLocks', @attributes ); 717} 718 719 720############################################################################## 721# 722# _write_xfrm() 723# 724# Write the <xdr:xfrm> element. 725# 726sub _write_xfrm { 727 728 my $self = shift; 729 730 $self->xml_start_tag( 'xdr:xfrm' ); 731 732 # Write the xfrmOffset element. 733 $self->_write_xfrm_offset(); 734 735 # Write the xfrmOffset element. 736 $self->_write_xfrm_extension(); 737 738 $self->xml_end_tag( 'xdr:xfrm' ); 739} 740 741 742############################################################################## 743# 744# _write_xfrm_offset() 745# 746# Write the <a:off> xfrm sub-element. 747# 748sub _write_xfrm_offset { 749 750 my $self = shift; 751 my $x = 0; 752 my $y = 0; 753 754 my @attributes = ( 755 'x' => $x, 756 'y' => $y, 757 ); 758 759 $self->xml_empty_tag( 'a:off', @attributes ); 760} 761 762 763############################################################################## 764# 765# _write_xfrm_extension() 766# 767# Write the <a:ext> xfrm sub-element. 768# 769sub _write_xfrm_extension { 770 771 my $self = shift; 772 my $x = 0; 773 my $y = 0; 774 775 my @attributes = ( 776 'cx' => $x, 777 'cy' => $y, 778 ); 779 780 $self->xml_empty_tag( 'a:ext', @attributes ); 781} 782 783 784############################################################################## 785# 786# _write_atag_graphic() 787# 788# Write the <a:graphic> element. 789# 790sub _write_atag_graphic { 791 792 my $self = shift; 793 my $index = shift; 794 795 $self->xml_start_tag( 'a:graphic' ); 796 797 # Write the a:graphicData element. 798 $self->_write_atag_graphic_data( $index ); 799 800 $self->xml_end_tag( 'a:graphic' ); 801} 802 803 804############################################################################## 805# 806# _write_atag_graphic_data() 807# 808# Write the <a:graphicData> element. 809# 810sub _write_atag_graphic_data { 811 812 my $self = shift; 813 my $index = shift; 814 my $uri = 'http://schemas.openxmlformats.org/drawingml/2006/chart'; 815 816 my @attributes = ( 'uri' => $uri, ); 817 818 $self->xml_start_tag( 'a:graphicData', @attributes ); 819 820 # Write the c:chart element. 821 $self->_write_c_chart( 'rId' . $index ); 822 823 $self->xml_end_tag( 'a:graphicData' ); 824} 825 826 827############################################################################## 828# 829# _write_c_chart() 830# 831# Write the <c:chart> element. 832# 833sub _write_c_chart { 834 835 my $self = shift; 836 my $r_id = shift; 837 my $schema = 'http://schemas.openxmlformats.org/'; 838 my $xmlns_c = $schema . 'drawingml/2006/chart'; 839 my $xmlns_r = $schema . 'officeDocument/2006/relationships'; 840 841 842 my @attributes = ( 843 'xmlns:c' => $xmlns_c, 844 'xmlns:r' => $xmlns_r, 845 'r:id' => $r_id, 846 ); 847 848 $self->xml_empty_tag( 'c:chart', @attributes ); 849} 850 851 852############################################################################## 853# 854# _write_client_data() 855# 856# Write the <xdr:clientData> element. 857# 858sub _write_client_data { 859 860 my $self = shift; 861 862 $self->xml_empty_tag( 'xdr:clientData' ); 863} 864 865 866############################################################################## 867# 868# _write_sp() 869# 870# Write the <xdr:sp> element. 871# 872sub _write_sp { 873 874 my $self = shift; 875 my $index = shift; 876 my $col_absolute = shift; 877 my $row_absolute = shift; 878 my $width = shift; 879 my $height = shift; 880 my $shape = shift; 881 882 if ( $shape->{_connect} ) { 883 my @attributes = ( macro => '' ); 884 $self->xml_start_tag( 'xdr:cxnSp', @attributes ); 885 886 # Write the xdr:nvCxnSpPr element. 887 $self->_write_nv_cxn_sp_pr( $index, $shape ); 888 889 # Write the xdr:spPr element. 890 $self->_write_xdr_sp_pr( $index, $col_absolute, $row_absolute, $width, 891 $height, $shape ); 892 893 $self->xml_end_tag( 'xdr:cxnSp' ); 894 } 895 else { 896 897 # Add attribute for shapes. 898 my @attributes = ( macro => '', textlink => '' ); 899 $self->xml_start_tag( 'xdr:sp', @attributes ); 900 901 # Write the xdr:nvSpPr element. 902 $self->_write_nv_sp_pr( $index, $shape ); 903 904 # Write the xdr:spPr element. 905 $self->_write_xdr_sp_pr( $index, $col_absolute, $row_absolute, $width, 906 $height, $shape ); 907 908 # Write the xdr:txBody element. 909 if ( $shape->{_text} ) { 910 $self->_write_txBody( $col_absolute, $row_absolute, $width, $height, 911 $shape ); 912 } 913 914 $self->xml_end_tag( 'xdr:sp' ); 915 } 916} 917############################################################################## 918# 919# _write_nv_cxn_sp_pr() 920# 921# Write the <xdr:nvCxnSpPr> element. 922# 923sub _write_nv_cxn_sp_pr { 924 925 my $self = shift; 926 my $index = shift; 927 my $shape = shift; 928 929 $self->xml_start_tag( 'xdr:nvCxnSpPr' ); 930 931 $shape->{_name} = join( ' ', $shape->{_type}, $index ) 932 unless defined $shape->{_name}; 933 $self->_write_c_nv_pr( $shape->{_id}, $shape->{_name} ); 934 935 $self->xml_start_tag( 'xdr:cNvCxnSpPr' ); 936 937 my @attributes = ( noChangeShapeType => '1' ); 938 $self->xml_empty_tag( 'a:cxnSpLocks', @attributes ); 939 940 if ( $shape->{_start} ) { 941 @attributes = 942 ( 'id' => $shape->{_start}, 'idx' => $shape->{_start_index} ); 943 $self->xml_empty_tag( 'a:stCxn', @attributes ); 944 } 945 946 if ( $shape->{_end} ) { 947 @attributes = ( 'id' => $shape->{_end}, 'idx' => $shape->{_end_index} ); 948 $self->xml_empty_tag( 'a:endCxn', @attributes ); 949 } 950 $self->xml_end_tag( 'xdr:cNvCxnSpPr' ); 951 $self->xml_end_tag( 'xdr:nvCxnSpPr' ); 952} 953 954 955############################################################################## 956# 957# _write_nv_sp_pr() 958# 959# Write the <xdr:NvSpPr> element. 960# 961sub _write_nv_sp_pr { 962 963 my $self = shift; 964 my $index = shift; 965 my $shape = shift; 966 967 my @attributes = (); 968 969 $self->xml_start_tag( 'xdr:nvSpPr' ); 970 971 my $shape_name = $shape->{_type} . ' ' . $index; 972 973 $self->_write_c_nv_pr( $shape->{_id}, $shape_name ); 974 975 @attributes = ( 'txBox' => 1 ) if $shape->{_txBox}; 976 977 $self->xml_start_tag( 'xdr:cNvSpPr', @attributes ); 978 979 @attributes = ( noChangeArrowheads => '1' ); 980 981 $self->xml_empty_tag( 'a:spLocks', @attributes ); 982 983 $self->xml_end_tag( 'xdr:cNvSpPr' ); 984 $self->xml_end_tag( 'xdr:nvSpPr' ); 985} 986 987 988############################################################################## 989# 990# _write_pic() 991# 992# Write the <xdr:pic> element. 993# 994sub _write_pic { 995 996 my $self = shift; 997 my $index = shift; 998 my $rel_index = shift; 999 my $col_absolute = shift; 1000 my $row_absolute = shift; 1001 my $width = shift; 1002 my $height = shift; 1003 my $description = shift; 1004 my $url_rel_index = shift; 1005 my $tip = shift; 1006 my $decorative = shift; 1007 1008 $self->xml_start_tag( 'xdr:pic' ); 1009 1010 # Write the xdr:nvPicPr element. 1011 $self->_write_nv_pic_pr( $index, $rel_index, $description, $url_rel_index, 1012 $tip, $decorative ); 1013 1014 # Write the xdr:blipFill element. 1015 $self->_write_blip_fill( $rel_index ); 1016 1017 # Pictures are rectangle shapes by default. 1018 my $shape = { _type => 'rect' }; 1019 1020 # Write the xdr:spPr element. 1021 $self->_write_sp_pr( $col_absolute, $row_absolute, $width, $height, 1022 $shape ); 1023 1024 $self->xml_end_tag( 'xdr:pic' ); 1025} 1026 1027 1028############################################################################## 1029# 1030# _write_nv_pic_pr() 1031# 1032# Write the <xdr:nvPicPr> element. 1033# 1034sub _write_nv_pic_pr { 1035 1036 my $self = shift; 1037 my $index = shift; 1038 my $rel_index = shift; 1039 my $description = shift; 1040 my $url_rel_index = shift; 1041 my $tip = shift; 1042 my $decorative = shift; 1043 1044 $self->xml_start_tag( 'xdr:nvPicPr' ); 1045 1046 # Write the xdr:cNvPr element. 1047 $self->_write_c_nv_pr( $index + 1, 'Picture ' . $index, 1048 $description, $url_rel_index, $tip, $decorative ); 1049 1050 # Write the xdr:cNvPicPr element. 1051 $self->_write_c_nv_pic_pr(); 1052 1053 $self->xml_end_tag( 'xdr:nvPicPr' ); 1054} 1055 1056 1057############################################################################## 1058# 1059# _write_c_nv_pic_pr() 1060# 1061# Write the <xdr:cNvPicPr> element. 1062# 1063sub _write_c_nv_pic_pr { 1064 1065 my $self = shift; 1066 1067 $self->xml_start_tag( 'xdr:cNvPicPr' ); 1068 1069 # Write the a:picLocks element. 1070 $self->_write_a_pic_locks(); 1071 1072 $self->xml_end_tag( 'xdr:cNvPicPr' ); 1073} 1074 1075 1076############################################################################## 1077# 1078# _write_a_pic_locks() 1079# 1080# Write the <a:picLocks> element. 1081# 1082sub _write_a_pic_locks { 1083 1084 my $self = shift; 1085 my $no_change_aspect = 1; 1086 1087 my @attributes = ( 'noChangeAspect' => $no_change_aspect ); 1088 1089 $self->xml_empty_tag( 'a:picLocks', @attributes ); 1090} 1091 1092 1093############################################################################## 1094# 1095# _write_blip_fill() 1096# 1097# Write the <xdr:blipFill> element. 1098# 1099sub _write_blip_fill { 1100 1101 my $self = shift; 1102 my $index = shift; 1103 1104 $self->xml_start_tag( 'xdr:blipFill' ); 1105 1106 # Write the a:blip element. 1107 $self->_write_a_blip( $index ); 1108 1109 # Write the a:stretch element. 1110 $self->_write_a_stretch(); 1111 1112 $self->xml_end_tag( 'xdr:blipFill' ); 1113} 1114 1115 1116############################################################################## 1117# 1118# _write_a_blip() 1119# 1120# Write the <a:blip> element. 1121# 1122sub _write_a_blip { 1123 1124 my $self = shift; 1125 my $index = shift; 1126 my $schema = 'http://schemas.openxmlformats.org/officeDocument/'; 1127 my $xmlns_r = $schema . '2006/relationships'; 1128 my $r_embed = 'rId' . $index; 1129 1130 my @attributes = ( 1131 'xmlns:r' => $xmlns_r, 1132 'r:embed' => $r_embed, 1133 ); 1134 1135 $self->xml_empty_tag( 'a:blip', @attributes ); 1136} 1137 1138 1139############################################################################## 1140# 1141# _write_a_stretch() 1142# 1143# Write the <a:stretch> element. 1144# 1145sub _write_a_stretch { 1146 1147 my $self = shift; 1148 1149 $self->xml_start_tag( 'a:stretch' ); 1150 1151 # Write the a:fillRect element. 1152 $self->_write_a_fill_rect(); 1153 1154 $self->xml_end_tag( 'a:stretch' ); 1155} 1156 1157 1158############################################################################## 1159# 1160# _write_a_fill_rect() 1161# 1162# Write the <a:fillRect> element. 1163# 1164sub _write_a_fill_rect { 1165 1166 my $self = shift; 1167 1168 $self->xml_empty_tag( 'a:fillRect' ); 1169} 1170 1171 1172############################################################################## 1173# 1174# _write_sp_pr() 1175# 1176# Write the <xdr:spPr> element, for charts. 1177# 1178sub _write_sp_pr { 1179 1180 my $self = shift; 1181 my $col_absolute = shift; 1182 my $row_absolute = shift; 1183 my $width = shift; 1184 my $height = shift; 1185 my $shape = shift || {}; 1186 1187 $self->xml_start_tag( 'xdr:spPr' ); 1188 1189 # Write the a:xfrm element. 1190 $self->_write_a_xfrm( $col_absolute, $row_absolute, $width, $height ); 1191 1192 # Write the a:prstGeom element. 1193 $self->_write_a_prst_geom( $shape ); 1194 1195 $self->xml_end_tag( 'xdr:spPr' ); 1196} 1197 1198 1199############################################################################## 1200# 1201# _write_xdr_sp_pr() 1202# 1203# Write the <xdr:spPr> element for shapes. 1204# 1205sub _write_xdr_sp_pr { 1206 1207 my $self = shift; 1208 my $index = shift; 1209 my $col_absolute = shift; 1210 my $row_absolute = shift; 1211 my $width = shift; 1212 my $height = shift; 1213 my $shape = shift; 1214 1215 my @attributes = ( 'bwMode' => 'auto' ); 1216 1217 $self->xml_start_tag( 'xdr:spPr', @attributes ); 1218 1219 # Write the a:xfrm element. 1220 $self->_write_a_xfrm( $col_absolute, $row_absolute, $width, $height, 1221 $shape ); 1222 1223 # Write the a:prstGeom element. 1224 $self->_write_a_prst_geom( $shape ); 1225 1226 my $fill = $shape->{_fill}; 1227 1228 if ( length $fill > 1 ) { 1229 1230 # Write the a:solidFill element. 1231 $self->_write_a_solid_fill( $fill ); 1232 } 1233 else { 1234 $self->xml_empty_tag( 'a:noFill' ); 1235 } 1236 1237 # Write the a:ln element. 1238 $self->_write_a_ln( $shape ); 1239 1240 $self->xml_end_tag( 'xdr:spPr' ); 1241} 1242 1243############################################################################## 1244# 1245# _write_a_xfrm() 1246# 1247# Write the <a:xfrm> element. 1248# 1249sub _write_a_xfrm { 1250 1251 my $self = shift; 1252 my $col_absolute = shift; 1253 my $row_absolute = shift; 1254 my $width = shift; 1255 my $height = shift; 1256 my $shape = shift || {}; 1257 my @attributes = (); 1258 1259 my $rotation = $shape->{_rotation} || 0; 1260 $rotation *= 60000; 1261 1262 push( @attributes, ( 'rot' => $rotation ) ) if $rotation; 1263 push( @attributes, ( 'flipH' => 1 ) ) if $shape->{_flip_h}; 1264 push( @attributes, ( 'flipV' => 1 ) ) if $shape->{_flip_v}; 1265 1266 $self->xml_start_tag( 'a:xfrm', @attributes ); 1267 1268 # Write the a:off element. 1269 $self->_write_a_off( $col_absolute, $row_absolute ); 1270 1271 # Write the a:ext element. 1272 $self->_write_a_ext( $width, $height ); 1273 1274 $self->xml_end_tag( 'a:xfrm' ); 1275} 1276 1277 1278############################################################################## 1279# 1280# _write_a_off() 1281# 1282# Write the <a:off> element. 1283# 1284sub _write_a_off { 1285 1286 my $self = shift; 1287 my $x = shift; 1288 my $y = shift; 1289 1290 my @attributes = ( 1291 'x' => $x, 1292 'y' => $y, 1293 ); 1294 1295 $self->xml_empty_tag( 'a:off', @attributes ); 1296} 1297 1298 1299############################################################################## 1300# 1301# _write_a_ext() 1302# 1303# Write the <a:ext> element. 1304# 1305sub _write_a_ext { 1306 1307 my $self = shift; 1308 my $cx = shift; 1309 my $cy = shift; 1310 1311 my @attributes = ( 1312 'cx' => $cx, 1313 'cy' => $cy, 1314 ); 1315 1316 $self->xml_empty_tag( 'a:ext', @attributes ); 1317} 1318 1319 1320############################################################################## 1321# 1322# _write_a_prst_geom() 1323# 1324# Write the <a:prstGeom> element. 1325# 1326sub _write_a_prst_geom { 1327 1328 my $self = shift; 1329 my $shape = shift || {}; 1330 1331 my @attributes = (); 1332 1333 @attributes = ( 'prst' => $shape->{_type} ) if $shape->{_type}; 1334 1335 $self->xml_start_tag( 'a:prstGeom', @attributes ); 1336 1337 # Write the a:avLst element. 1338 $self->_write_a_av_lst( $shape ); 1339 1340 $self->xml_end_tag( 'a:prstGeom' ); 1341} 1342 1343 1344############################################################################## 1345# 1346# _write_a_av_lst() 1347# 1348# Write the <a:avLst> element. 1349# 1350sub _write_a_av_lst { 1351 1352 my $self = shift; 1353 my $shape = shift || {}; 1354 my $adjustments = []; 1355 1356 if ( defined $shape->{_adjustments} ) { 1357 $adjustments = $shape->{_adjustments}; 1358 } 1359 1360 if ( @$adjustments ) { 1361 $self->xml_start_tag( 'a:avLst' ); 1362 1363 my $i = 0; 1364 foreach my $adj ( @{$adjustments} ) { 1365 $i++; 1366 1367 # Only connectors have multiple adjustments. 1368 my $suffix = $shape->{_connect} ? $i : ''; 1369 1370 # Scale Adjustments: 100,000 = 100%. 1371 my $adj_int = int( $adj * 1000 ); 1372 1373 my @attributes = 1374 ( name => 'adj' . $suffix, fmla => "val $adj_int" ); 1375 1376 $self->xml_empty_tag( 'a:gd', @attributes ); 1377 } 1378 $self->xml_end_tag( 'a:avLst' ); 1379 } 1380 else { 1381 $self->xml_empty_tag( 'a:avLst' ); 1382 } 1383} 1384 1385 1386############################################################################## 1387# 1388# _write_a_solid_fill() 1389# 1390# Write the <a:solidFill> element. 1391# 1392sub _write_a_solid_fill { 1393 1394 my $self = shift; 1395 my $rgb = shift; 1396 1397 $rgb = '000000' unless defined $rgb; 1398 1399 my @attributes = ( 'val' => $rgb ); 1400 1401 $self->xml_start_tag( 'a:solidFill' ); 1402 1403 $self->xml_empty_tag( 'a:srgbClr', @attributes ); 1404 1405 $self->xml_end_tag( 'a:solidFill' ); 1406} 1407 1408 1409############################################################################## 1410# 1411# _write_a_ln() 1412# 1413# Write the <a:ln> element. 1414# 1415sub _write_a_ln { 1416 1417 my $self = shift; 1418 my $shape = shift || {}; 1419 1420 my $weight = $shape->{_line_weight}; 1421 1422 my @attributes = ( 'w' => $weight * 9525 ); 1423 1424 $self->xml_start_tag( 'a:ln', @attributes ); 1425 1426 my $line = $shape->{_line}; 1427 1428 if ( length $line > 1 ) { 1429 1430 # Write the a:solidFill element. 1431 $self->_write_a_solid_fill( $line ); 1432 } 1433 else { 1434 $self->xml_empty_tag( 'a:noFill' ); 1435 } 1436 1437 if ( $shape->{_line_type} ) { 1438 1439 @attributes = ( 'val' => $shape->{_line_type} ); 1440 $self->xml_empty_tag( 'a:prstDash', @attributes ); 1441 } 1442 1443 if ( $shape->{_connect} ) { 1444 $self->xml_empty_tag( 'a:round' ); 1445 } 1446 else { 1447 @attributes = ( 'lim' => 800000 ); 1448 $self->xml_empty_tag( 'a:miter', @attributes ); 1449 } 1450 1451 $self->xml_empty_tag( 'a:headEnd' ); 1452 $self->xml_empty_tag( 'a:tailEnd' ); 1453 1454 $self->xml_end_tag( 'a:ln' ); 1455} 1456 1457 1458############################################################################## 1459# 1460# _write_txBody 1461# 1462# Write the <xdr:txBody> element. 1463# 1464sub _write_txBody { 1465 1466 my $self = shift; 1467 my $col_absolute = shift; 1468 my $row_absolute = shift; 1469 my $width = shift; 1470 my $height = shift; 1471 my $shape = shift; 1472 1473 my @attributes = ( 1474 vertOverflow => "clip", 1475 wrap => "square", 1476 lIns => "27432", 1477 tIns => "22860", 1478 rIns => "27432", 1479 bIns => "22860", 1480 anchor => $shape->{_valign}, 1481 upright => "1", 1482 ); 1483 1484 $self->xml_start_tag( 'xdr:txBody' ); 1485 $self->xml_empty_tag( 'a:bodyPr', @attributes ); 1486 $self->xml_empty_tag( 'a:lstStyle' ); 1487 1488 $self->xml_start_tag( 'a:p' ); 1489 1490 my $rotation = $shape->{_format}->{_rotation}; 1491 $rotation = 0 unless defined $rotation; 1492 $rotation *= 60000; 1493 1494 @attributes = ( algn => $shape->{_align}, rtl => $rotation ); 1495 $self->xml_start_tag( 'a:pPr', @attributes ); 1496 1497 @attributes = ( sz => "1000" ); 1498 $self->xml_empty_tag( 'a:defRPr', @attributes ); 1499 1500 $self->xml_end_tag( 'a:pPr' ); 1501 $self->xml_start_tag( 'a:r' ); 1502 1503 my $size = $shape->{_format}->{_size}; 1504 $size = 8 unless defined $size; 1505 $size *= 100; 1506 1507 my $bold = $shape->{_format}->{_bold}; 1508 $bold = 0 unless defined $bold; 1509 1510 my $italic = $shape->{_format}->{_italic}; 1511 $italic = 0 unless defined $italic; 1512 1513 my $underline = $shape->{_format}->{_underline}; 1514 $underline = $underline ? 'sng' : 'none'; 1515 1516 my $strike = $shape->{_format}->{_font_strikeout}; 1517 $strike = $strike ? 'Strike' : 'noStrike'; 1518 1519 @attributes = ( 1520 lang => "en-US", 1521 sz => $size, 1522 b => $bold, 1523 i => $italic, 1524 u => $underline, 1525 strike => $strike, 1526 baseline => 0, 1527 ); 1528 1529 $self->xml_start_tag( 'a:rPr', @attributes ); 1530 1531 my $color = $shape->{_format}->{_color}; 1532 if ( defined $color ) { 1533 $color = $shape->_get_palette_color( $color ); 1534 $color =~ s/^FF//; # Remove leading FF from rgb for shape color. 1535 } 1536 else { 1537 $color = '000000'; 1538 } 1539 1540 $self->_write_a_solid_fill( $color ); 1541 1542 my $font = $shape->{_format}->{_font}; 1543 $font = 'Calibri' unless defined $font; 1544 @attributes = ( typeface => $font ); 1545 $self->xml_empty_tag( 'a:latin', @attributes ); 1546 1547 $self->xml_empty_tag( 'a:cs', @attributes ); 1548 1549 $self->xml_end_tag( 'a:rPr' ); 1550 1551 $self->xml_data_element( 'a:t', $shape->{_text} ); 1552 1553 $self->xml_end_tag( 'a:r' ); 1554 $self->xml_end_tag( 'a:p' ); 1555 $self->xml_end_tag( 'xdr:txBody' ); 1556 1557} 1558 1559 15601; 1561__END__ 1562 1563=pod 1564 1565=head1 NAME 1566 1567Drawing - A class for writing the Excel XLSX drawing.xml file. 1568 1569=head1 SYNOPSIS 1570 1571See the documentation for L<Excel::Writer::XLSX>. 1572 1573=head1 DESCRIPTION 1574 1575This module is used in conjunction with L<Excel::Writer::XLSX>. 1576 1577=head1 AUTHOR 1578 1579John McNamara jmcnamara@cpan.org 1580 1581=head1 COPYRIGHT 1582 1583(c) MM-MMXXI, John McNamara. 1584 1585All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. 1586 1587=head1 LICENSE 1588 1589Either the Perl Artistic Licence L<http://dev.perl.org/licenses/artistic.html> or the GPL L<http://www.opensource.org/licenses/gpl-license.php>. 1590 1591=head1 DISCLAIMER OF WARRANTY 1592 1593See the documentation for L<Excel::Writer::XLSX>. 1594 1595=cut 1596