Chinaunix首页 | 论坛 | 博客
  • 博客访问: 226033
  • 博文数量: 36
  • 博客积分: 1188
  • 博客等级: 军士长
  • 技术积分: 802
  • 用 户 组: 普通用户
  • 注册时间: 2010-04-08 21:45
文章分类

全部博文(36)

文章存档

2020年(1)

2017年(2)

2015年(1)

2014年(1)

2013年(1)

2012年(3)

2011年(27)

分类: WINDOWS

2011-05-01 12:46:12

如果你需做的ppt也是一行标题,一段正文;或一行标题,一张图片。可以使用本代码来简化工作。
使用:
__DATA__
=> 标题1
  正文......段落1结束
=> 图片标题1
  1.jpg
...
说明:
=> 表示标题,为正文;=>为图片标题,为图片名,并保证图片与代码放于同一文件夹。
 
注:本代码依赖模块有Win32::PowerPoint、Moo、Sub::Quote、Class::Accessor::Fast与Cwd,请自行安装。
  1. package PPT;
  2. #use Acme::PerlTidy;
  3. use Moo;
  4. use Sub::Quote;

  5. #但凡调用方法为:$self->{ppt}->方法()的,均是调用的Win32::PowerPoint类的方法
  6. use base qw( Class::Accessor::Fast );
  7. __PACKAGE__->mk_ro_accessors(qw(ppt));

  8. #属性T_bold、B_bold为布尔值,分别用来设置标题(Title)与正文(Body)是否为粗体
  9. #属性T_FN、B_FN分别用来设置标题(Title_Font_Name)与正文(Body_Font_Name)的字体,例子中为“楷体_GB2312”
  10. #属性T_FS、B_FS分别用来设置标题(Title_Font_Size)与正文(Body_Font_Size)的字体大小
  11. has T_bold => ( is => 'rw' );
  12. has T_FN => ( is => 'rw' );
  13. has T_FS => (
  14.     is => 'rw',
  15.     isa => quote_sub q{ die "字体太大了" unless $_[0] =~ /^\d{1,2}$/ }
  16. );
  17. has B_bold => ( is => 'rw', );
  18. has B_FN => ( is => 'rw' );
  19. has B_FS => (
  20.     is => 'rw',
  21.     isa => quote_sub q{ die "字体太大了" unless $_[0] =~ /^\d{1,2}$/ }
  22. );

  23. sub AddBody {
  24.     my ( $self, $text_T, $text_B ) = @_;

  25.     #检测是否已存在Win32::PowerPoint,无的话实例化Win32::PowerPoint。
  26.     if ( !$self->{ppt} ) {
  27.         $self->_win32ppt();
  28.     }

  29. #new_slidet()为Win32::PowerPoint类的方法,用于新建一个幻灯片,详见Win32::PowerPoint文档
  30.     $self->{ppt}->new_slide;
  31.     $self->_addTitle($text_T);

  32.  #add_text()为Win32::PowerPoint类的方法,用于写入文字,详见Win32::PowerPoint文档
  33.     $self->{ppt}->add_text(
  34.         $text_B,
  35.         {
  36.             left => 5,
  37.             top => 100,
  38.             width => 710,
  39.             height => 150,
  40.             size => $self->B_FS,
  41.             bold => $self->B_bold,
  42.             name => $self->B_FN
  43.         }
  44.     );
  45. }

  46. sub AddPicture {
  47.     my ( $self, $text_T, $picture ) = @_;
  48.     if ( !$self->{ppt} ) {
  49.         $self->_win32ppt();
  50.     }
  51.     $self->{ppt}->new_slide;
  52.     $self->_addTitle($text_T);

  53. #add_picture()为Win32::PowerPoint类的方法,用于添加图片,详见Win32::PowerPoint文档
  54.     $self->{ppt}->add_picture( $picture,
  55.         { left => 10, top => 100, width => 700, height => 300, link => 0 } );
  56. }

  57. sub _win32ppt {
  58.     require Win32::PowerPoint;
  59.     my $self = shift;
  60.     $self->{ppt} = Win32::PowerPoint->new;
  61.     $self->{ppt}->new_presentation(
  62.         background_forecolor => [ 255, 255, 255 ],
  63.         background_backcolor => 'RGB(255,255,255)',
  64.     );
  65. }

  66. sub _addTitle {
  67.     my ( $self, $text_T ) = @_;
  68.     $self->{ppt}->add_text(
  69.         $text_T,
  70.         {
  71.             left => 0,
  72.             top => 50,
  73.             width => 680,
  74.             height => 50,
  75.             size => $self->T_FS,
  76.             bold => $self->T_bold,
  77.             name => $self->T_FN
  78.         }
  79.     );
  80. }

  81. sub SaveQuit {
  82.     my ( $self, $name ) = @_;
  83.     $self->{ppt}->save_presentation($name);
  84.     $self->{ppt}->close_presentation;
  85. }

  86. package main;
  87. use Cwd;
  88. my $dir = Cwd::getcwd();
  89. my $ppt = new PPT(
  90.     T_FN => '楷体_GB2312',
  91.     T_FS => 28,
  92.     T_bold => 1,
  93.     B_FN => '楷体_GB2312',
  94.     B_FS => 24,
  95.     B_bold => 0
  96. );

  97. {

  98.     #以=>作为换行符
  99.     local $/ = '=>';
  100.     while ( my $data = <DATA> ) {
  101.         my ( %hash, $temp, %rethash );

  102.         #=><BT> 标题1
  103.         # <BB> 正文......段落1结束
  104.         #$hash{BT}=标题1;$hash{BB}=正文......段落1结束
  105.         while ( $data =~ /<(\w{2})>(.*)/g ) {
  106.             $hash{$1} = $2;
  107.         }
  108.         my @arr = grep { /(\w)\1/ } keys %hash;

  109.         #$temp=BB;
  110.         $temp = $arr[0];

  111. #根据%hash改变散列结构,生成%rethash,$rethash{BB}{BT} = 标题1,$rethash{BB}{BB} = 正文......段落1结束
  112.         for my $key ( keys %hash ) {
  113.             $rethash{$temp}{$key} = $hash{$key};
  114.         }

  115.         for my $retkey ( keys %rethash ) {
  116.             if ( $retkey eq 'BB' ) {
  117.                 $ppt->AddBody( $rethash{'BB'}{'BT'}, $rethash{'BB'}{'BB'} );
  118.             }
  119.             elsif ( $retkey eq 'PP' ) {
  120.                 my $picture = $rethash{'PP'}{'PP'};
  121.                 $picture =~ s/\s*//g;
  122.                 my $picpath = $dir . '/' . $picture;
  123.                 $ppt->AddPicture( $rethash{'PP'}{'PT'}, $picpath );
  124.             }

  125.         }

  126.     }
  127. }
  128. $ppt->SaveQuit('报告.ppt');

  129. __DATA__
  130. =><BT> 标题1
  131.   <BB> 正文......段落1结束
  132. =><PT> 图片标题1
  133.   <PP> 1.jpg
  134. =><BT> 标题2
  135.   <BB> 正文......段落2结束
  136. =><PT> 图片标题2
  137.   <PP> 2.png
阅读(2386) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~