Andy Blyler wrote:

> Anyone now a quick and easy way to shrink a picture to about 1/3 of its
> origonal size so that it can be indexed?
>
> Andy Blyler
>
> ---
> You are currently subscribed to perl-win32-users as: [EMAIL PROTECTED]
> To unsubscribe, forward this message to
>          [EMAIL PROTECTED]
> For non-automated Mailing List support, send email to
>          [EMAIL PROTECTED]

here is a script I wrote that takes a dir of jpg images 1600x1200 and converts them
to:
800x600 and 200x150
and writes a html page to reference them.
It uses the Image::Magick module that seems to work pretty good.

bob

--------------------------------------
#!perl -w
use strict;
use Image::Magick;

# globals
my $WebSize=600;
my $TbNSize=150;
my $FileNum;

Main(@ARGV);

sub Main {
 my @FileList = @_;
 my $Html = "Image.html";
 open (HTML, ">$Html") or die "die cant open output $Html: $!\n";

 PrtHead();
 $FileNum = 0;
 for my $a (@FileList) {
  if ($a =~ /\*|\?/) {
   for my $a (glob($a)) {
    CvtImg($a);
   }
  } else {
   CvtImg($a);
  }
 }
 PrtTail();

}

sub CvtImg {
 my ($a) = @_;
 my ($H, $W, $NewW);
 my $im = Image::Magick->new;
 print "converting:$a\n";
 $im->Read($a);
 $H=$im->Get('height');
 $W=$im->Get('width');
 $NewW = $W * $WebSize / $H;
 $im->Scale(width=>$NewW, height=>$WebSize);
 print $im->Write("WebPic/$a");
 $NewW = $W * $TbNSize / $H;
 $im->Scale(width=>$NewW, height=>$TbNSize);
 print $im->Write("TbNail/$a");
 PrtHtml($a);
 undef $im;
}

sub PrtHead {
 print HTML <<EOF;
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
<head>
   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
   <meta name="Author" content="Robert Davis">
   <meta name="GENERATOR" content="Mozilla/4.61 [en] (Win98; U) [Netscape]">
   <title>Lost Angeles Vacation</title>
</head>
<body>
EOF
}

sub PrtHtml {
 my($Fn) = @_;
 print HTML qq(<a href="WebPic/$Fn"><img SRC="TbNail/$Fn" </a>\n);
# if ((++$FileNum % 4) == 0) {
#  print HTML "<br>\n";
# }
}

sub PrtTail {
 print HTML <<EOF;
</body>
</html>
EOF

}

------------------------------

--
[EMAIL PROTECTED]
[EMAIL PROTECTED]
http://people.ne.mediaone.net/rsdavis
http://rsdavis.ne.mediaone.net



---
You are currently subscribed to perl-win32-users as: [archive@jab.org]
To unsubscribe, forward this message to
         [EMAIL PROTECTED]
For non-automated Mailing List support, send email to  
         [EMAIL PROTECTED]

Reply via email to