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]
