1: # This is a simple program to resize one jpeg size or all
2: # the jpeg files from a given directory
3: # script.pl -d directory height width , will change all the
4: # files to that new size,
5: # script -a file.jpg height width , will change just a file
6: # If a image is 100 x 200 then the program will try to
7: # adjust a given height and width to mantain the scale
8: # I know this program must have some bug, or maybe i use
9: # too much code for something, but this was one of my first
10: # perl scripts :)
11: # The script has some comments in spanish cuz here in Costa
12: # Rica we speak spanish
13:
14: use GD;
15: use strict;
16:
17: sub changeSize{
18:
19: if ( @_ ) {
20:
21: my $file = "$_[0]" ;
22: my $newFile = "new".$file;
23: open(JPEG,">$newFile");
24: binmode JPEG;
25: my $newWidth = $_[1];
26: my $newHeight = $_[2];
27: my $quality = 100;
28: if ( $_[3] ) { $quality = $_[3] if ( $_[3] =~ /[1..100]/ ) ; }
29:
30: my $myImage = newFromJpeg GD::Image($file);
31:
32:
33: my @size = $myImage->getBounds( ) ;
34: my $currentWidth = $size[0];
35: my $currentHeight = $size[1];
36:
37:
38:
39: if ( $currentWidth != $currentHeight ) {
40:
41: my $factor = ($currentWidth / $currentHeight);
42: $factor = $newWidth / $factor;
43: $newHeight = int($factor);
44:
45: }
46:
47: my $newImage = new GD::Image($newWidth,$newHeight);
48:
49:
50: $newImage->copyResized($myImage,0,0,0,0,$newWidth,$newHeight,$currentWidth,$currentHeight);
51:
52: print JPEG $newImage->jpeg($quality);
53: close(JPEG);
54:
55:
56: }
57:
58: }
59:
60: my $param = "$ARGV[0]";
61: my $dir = "$ARGV[1]" ;
62: my $newWidth = "$ARGV[2]" ;
63: my $newHeight= "$ARGV[3]" ;
64: my $newQuality = "$ARGV[4]" ;
65:
66: my @tmp = split(/\\/,$0);
67: my $name = $tmp[-1];
68:
69: if ( $param eq "-a" ) {
70:
71: if ( -f $dir ){
72:
73: &changeSize($dir,$newWidth,$newHeight,$newQuality) if ( $dir =~ /.*\.jpg/);
74:
75:
76: } else { print "Estas seguro que $dir es un archivo ? :) "; }
77:
78: } elsif ( $param eq "-d" ) {
79:
80: opendir(DIR,$dir) or die "Error abriendo directorio $dir\n";
81:
82: my @onlyFiles = grep {-f "$dir/$_"} readdir(DIR); # I get this trick from the Q/A area :)
83:
84: foreach my $file (@onlyFiles) {
85:
86:
87: if ( $file =~ /.*\.jpg/ ) {
88:
89: &changeSize($file,$newWidth,$newHeight,$newQuality);
90:
91: }
92:
93:
94: }
95:
96: } else { print "Error :( "; }
97:
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: JPEG Files ReSize
by John M. Dlugosz (Monsignor) on Aug 25, 2001 at 12:38 UTC | |
|
Re: JPEG Files ReSize
by bladx (Chaplain) on Aug 25, 2001 at 08:58 UTC | |
by John M. Dlugosz (Monsignor) on Aug 25, 2001 at 11:49 UTC |