I have had quite good success using ImageMagick along with the Image::Magick module (on both Win98 and Win2K). I suspect that you probably don't have it installed properly. ar0n has posted a program to do what you want and there is a link to merlyn as well in the thread creating thumbnails. I took a little from each and wrote my own for the very purpose you mentioned:
use strict;
use Image::Magick;
# Allowable image suffixes
my %IMsuffixes = (
jpg => 1,
bmp => 1,
gif => 1,
jpeg => 1,
png => 1,
tiff => 1,
tif => 1,
wpg => 1
);
my $max_dim = 125;
my $path = 'C:/My Files/My pictures/Pets';
my @images = glob "'$path/*'";
print "Path: '$path'\n";
foreach (@images) {
s!.*/!!;
next if lc substr($_, 0, 3) eq 'tn.';
my $suf = $_;
$suf =~ s/.*\.//;
if (exists $IMsuffixes{$suf}) {
ThumbNail($path, $_, "tn.", $max_dim);
} else {
print "INVALID suffix: '.$suf', file: '$_' Skipping . . .\n";
}
}
sub ThumbNail {
my ($path, $file, $prefix, $max_dim) = @_;
if (! ($path && $file && $prefix && $max_dim)) {
print "ERROR - Invalid Parameter to sub 'ThumbNail': \n",
" path => '$path\n'",
" file => '$file'\n",
" prefix => '$prefix'\n",
" max_dim => '$max_dim'\n\n";
exit;
}
my $img = new Image::Magick;
my $imerrmsg = $img->Read("$path/$file");
Process_IM_Error($imerrmsg) if $imerrmsg;
my ($width, $height) = $img->Get("width", "height");
if ($width * $height == 0) {
print "ERROR - Image: '$path/$file' dimensions must be nonzero:
+\n",
" width => '$width'\n",
" height => '$height'\n\n";
exit;
}
my ($new_height, $new_width);
if ($width > $height) {
$new_width = $max_dim;
$new_height = int($height * $new_width / $width);
} else {
$new_height = $max_dim;
$new_width = int($width * $new_height / $height);
}
$imerrmsg = $img->Resize( width => $new_width,
height => $new_height,
blur => 1 );
Process_IM_Error($imerrmsg) if $imerrmsg;
$img->Write("$path/$prefix$file");
print pack("A48", "$prefix$file"),
" W => ", pack("A3", $new_width),
" H => ", pack("A3", $new_height), "\n";
}
sub Process_IM_Error {
my $errmsg = shift;
print "Made it to Process_IM_Error sub\n";
print shift, "\n";
if ("$errmsg") {
$errmsg =~ /(\d+)/;
exit if ($1 >= 400);
}
}
--Jim |