Förord

Denna artikel tar upp hur man skapar en subrutin för att skala om bilder "on-the-fly". Subrutinen använder sig i detta exempel utav bildkomponenten aspJpeg från Persuit (http://www.aspjpeg.com). Jag skall även komplettera med w3Image, aspImage mfl... Ursäkta att språket är så varierande. Jag anser att det är bra att kommentera i engelska så scriptet kan användas av fler människor

Innehåll

  » 1. Deklarera subrutinen
  » 2. Defaultvärden
  » 3. Initiera aspJpeg
  » 4. Omskalningen
  » 5. Spara den omskalade bilden
  » 6. Stäng alla öppna komponenter
  » Subrutinen i sin helhet
  » Anropet:
  » Fler användningsområden

Det är att föredra att du har denna subrutin i en fil som du inkluderar på alla, eller de sidor du behöver nyttja funktionen.

Man kan använda följande bildformat: JPEG, GIF, BMP, TIFF eller PNG

1. Deklarera subrutinen

Börja med att deklarera subrutinen. Låt oss kalla den "MakeThumb"
Till den så anger vi vilka parametrar som skall anges för att kunna vara så flexibla som möjligt.

<%
Sub MakeThumb(filepath, savefolder, maxwidth, maxheight, unique)
%>


Parametrarna kanske talar för sig själva men jag tar upp dem ändå:
filepath (obligatorisk) fullständig sökväg till originalbilden som skall omskalas
savefolder sökväg till mappen där den förminskade bilden skall sparas i. Om inget anges försöker den spara i den förinställda sparamappen under den mapp som originalbilden ligger i"
maxwidth den omskalade bildens nya bredd.
maxheight den omskalade bildens nya höjd.

maxwidth & maxheight kan man kombinera.
Först skalas bilden om proportionsenligt, och är den nya höjden större än den maxhöjd man satt så skalas bilden om ytterligare för att passa maxhöjden.
Om man inte anger antingen maxwidth eller maxheight så går omskalningsfunktionen efter defaultvärden som man anger i subrutinen.
unique (true eller false (false som default) ) om den omskalade bilden skall skriva över befintlig fil eller inte
True anger man om den inte skall skriva över befintlig fil utan generera nytt filnamn automatiskt, enligt image(1).jpg, image(2).jpg, etc Fungerar dock endast i version 1.7 och upp.

2. Defaultvärden

<%

'**Defaults
default_savepath="c:\inetpub\wwwroot\projectx\imagefolder\"
default_maxwidth=100
default_maxheight=100

'** Check parameters
Set fs=Server.CreateObject("Scripting.FileSystemObject")
if filepath="" Then Exit Sub
'since this paragraph has no default value and it is a critical
'variable you have to end the sub rutine, else it vill nog work anyway.
if fs.FileExists(filepath)=False Then Exit Sub
filename=fs.GetFileName(filepath)

if savefolder="" Then savefolder = default_savefolder
if right(savefolder,1)<> "\" Then savefolder=savefolder&"\"
if fs.FolderExists(savefolder)=False Then Exit Sub

if Isnumeric(maxwidth)=false Or 0>maxwidth Then maxwidth = default_maxwidth
if Isnumeric(maxheight)=false Or 0>maxheight Then maxheight = default_maxheight
%>
Sådär!

Nu är vi klara med det initiella i subrutinen. Nu skall vi introducera aspJpeg

3. Initiera aspJpeg

<%
On Error Exit Sub
'** initiate Jpeg-function and open original image
Set Jpeg = Server.CreateObject("Persuits.Jpeg")
Jpeg.Open filepath
%>

Om aspJpeg inte hittar filen i fråga kommer den alltså inte utföra någon omskalning, därför en "On Error Exit Sub hellre än "Resume Next"

Nu till själva omskalningen:

4. Omskalningen

<%
On Error Exit Sub
'** initiate Jpeg-function and open original image
Set Jpeg = Server.CreateObject("Persuits.Jpeg")
Jpeg.Open filepath

'** Resize
Jpeg.Quality = 90 '"100 = no compression = largest filesize"
Jpeg.PreserveAspectRatio = True ' from V1.4
If Jpeg.Width > Jpeg.Height Or maxheight=0 Then
Jpeg.Width = maxwidth
Else
Jpeg.Height = maxheight
End if

'** If aspJpeg version < 1.4 use rows below instead
'Jpeg.Width = maxwidth
'Jpeg.Height = (Jpeg.OriginalHeight * maxwidth / Jpeg.OriginalWidth)
'if Jpeg.Height > maxheight Then
' Jpeg.Height = maxheight
' Jpeg.Width = (maxwidth * maxwidth / maxheight )
'End if


%>

5. Spara den omskalade bilden

<%
'** Only in version 1.7 and greater
if unique=True Then
Jpeg.SaveUnique savefolder & filename
Else
Jpeg.Save savefolder & filename
End if
%>

6. Stäng alla öppna komponenter

<%
Set Jpeg = nothing
Set fs = nothing
End Sub
%>



Sådär!
Det var väl inte så svårt eller?!

Subrutinen i sin helhet

<%
Sub MakeThumb(filepath, savefolder, maxwidth, maxheight, unique)

'**Defaults
default_savepath="c:\inetpub\wwwroot\projectx\imagefolder\"
default_maxwidth=100
default_maxheight=100

'** Check parameters
Set fs=Server.CreateObject("Scripting.FileSystemObject")
if filepath="" Then Exit Sub
'since this paragraph has no default value and it is a critical
'variable you have to end the sub rutine, else it vill nog work anyway.
if fs.FileExists(filepath)=False Then Exit Sub
filename=fs.GetFileName(filepath)

if savefolder="" Then savefolder = default_savefolder
if right(savefolder,1)<> "\" Then savefolder=savefolder&"\"
if fs.FolderExists(savefolder)=False Then Exit Sub

if Isnumeric(maxwidth)=false Or 0>maxwidth Then maxwidth = default_maxwidth
if Isnumeric(maxheight)=false Or 0>maxheight Then maxheight = default_maxheight

On Error Exit Sub
'** initiate Jpeg-function and open original image
Set Jpeg = Server.CreateObject("Persuits.Jpeg")
Jpeg.Open filepath

'** Resize
Jpeg.Quality = 90 '"100 = no compression = largest filesize"
Jpeg.PreserveAspectRatio = True ' from V1.4
If Jpeg.Width > Jpeg.Height Or maxheight=0 Then
Jpeg.Width = maxwidth
Else
Jpeg.Height = maxheight
End if

'** If aspJpeg version < 1.4 use rows below instead
'Jpeg.Width = maxwidth
'Jpeg.Height = (Jpeg.OriginalHeight * maxwidth / Jpeg.OriginalWidth)
'if Jpeg.Height > maxheight Then
' Jpeg.Height = maxheight
' Jpeg.Width = (maxwidth * maxwidth / maxheight )
'End if

'** Only in version 1.7 and greater
if unique=True Then
Jpeg.SaveUnique savefolder & filename
Else
Jpeg.Save savefolder & filename
End if

Set Jpeg = nothing
Set fs = nothing
End Sub
%>


Anropet:

Så här anropar man (flera exempel ).
Observera att paranterser används inte direkt efter anropet som man gör när man anropar en funktion( Function)

<%
bigimage = server.mappath("bigimage.jpg")

' Generates a 200px wide thumbnail from the originalimage, saves it in the default save
folder
MakeThumb bigimage, "", 200, 0, true

' Generates a 50px high thumbnail from the originalimage, saves it in a specific folder
MakeThumb bigimage, server.mappath("../../thumbsfolder/"), 0, 50, true

' Generates a 200px wide or max 100px high thumbnail from the originalimage, saves it in
the default save folder
MakeThumb bigimage, "", 200, 100, true

%>
notera att server.mappath("../../thumbsfolder/") kan vara avstängt på vissa servrar/webbhotell pga säkerhetsrisk

Fler användningsområden

Det är väldigt smidigt att använda subrutinen i en loop, för att kolla igenom en mapp om den har tillhörande tumnaglar. Om inte, så skapa en och lägg i en undermapp. Perfekt om man skall göra sitt eget fotogalleri.
Exempel:


<%
imagefolder="c:\inetpub\wwwroot\subfolder\images\"
set fso=Server.CreateObject("Scripting.FileSystemObject")
Set Folder= Fso.GetFolder(imagefolder)
Set Files=Folder.Files

For Each File in Files
if fso.FileExists(imagefolder &"thumbs\"&File.Name)=false Then
MakeThumb imagefolder &File.Name, imagefolder &"thumbs\", 200, 0, false
Next

Set Files=Nothing
Set Folder=Nothing
Set fso=Nothing

%>



Notera att jag inte alls testat detta vid skrivtillfället. Men kommer att göra detta och revidera om det skulle behövas.

1 Kommentarer

1. 
   Pelle Johansson
   

   18 maj 2007

   Många har frågat efter detta och inte fått till det korrekt.

Skriv en kommentar på artikeln

Ditt betyg på artikeln

UtmärktLäsvärdIntressantMindre braDålig

Kommentar: