|
rdouglass -> RE: Looking to resize an image (10/5/2005 15:54:39)
|
Just my $.02
I do a lot of work on Intranets and this may not be a good solution for Internet sites but I find it very handy.
Normally, I'll want to include the client's logo or other images many places in the site at many different sizes. I've 'kludged' together some ASP functions that takes any image and scales it down to whatever width you desire - and it looks good to boot. This has saved me quite a bit of time since I don't have to scale images anymore.
Here goes:
Put *all* of this code somewhere at the top of the page before the <head> tag. (I normally will put this in an include file since I use it in many pages throughout the site.)
<%
function GetBytes(flnm, offset, bytes)
Dim objFSO
Dim objFTemp
Dim objTextStream
Dim lngSize
on error resume next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFTemp = objFSO.GetFile(flnm)
lngSize = objFTemp.Size
set objFTemp = nothing
fsoForReading = 1
Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)
if offset > 0 then
strBuff = objTextStream.Read(offset - 1)
end if
if bytes = -1 then ' Get All!
GetBytes = objTextStream.Read(lngSize) 'ReadAll
else
GetBytes = objTextStream.Read(bytes)
end if
objTextStream.Close
set objTextStream = nothing
set objFSO = nothing
end function
function lngConvert(strTemp)
lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
end function
function lngConvert2(strTemp)
lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
end function
function gfxSpex(flnm, width, height, depth, strImageType)
dim strPNG
dim strGIF
dim strBMP
dim strType
strType = ""
strImageType = "(unknown)"
gfxSpex = False
strPNG = chr(137) & chr(80) & chr(78)
strGIF = "GIF"
strBMP = chr(66) & chr(77)
strType = GetBytes(flnm, 0, 3)
if strType = strGIF then ' is GIF
strImageType = "GIF"
Width = lngConvert(GetBytes(flnm, 7, 2))
Height = lngConvert(GetBytes(flnm, 9, 2))
Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
gfxSpex = True
elseif left(strType, 2) = strBMP then ' is BMP
strImageType = "BMP"
Width = lngConvert(GetBytes(flnm, 19, 2))
Height = lngConvert(GetBytes(flnm, 23, 2))
Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
gfxSpex = True
elseif strType = strPNG then ' Is PNG
strImageType = "PNG"
Width = lngConvert2(GetBytes(flnm, 19, 2))
Height = lngConvert2(GetBytes(flnm, 23, 2))
Depth = getBytes(flnm, 25, 2)
select case asc(right(Depth,1))
case 0
Depth = 2 ^ (asc(left(Depth, 1)))
gfxSpex = True
case 2
Depth = 2 ^ (asc(left(Depth, 1)) * 3)
gfxSpex = True
case 3
Depth = 2 ^ (asc(left(Depth, 1))) '8
gfxSpex = True
case 4
Depth = 2 ^ (asc(left(Depth, 1)) * 2)
gfxSpex = True
case 6
Depth = 2 ^ (asc(left(Depth, 1)) * 4)
gfxSpex = True
case else
Depth = -1
end select
else
strBuff = GetBytes(flnm, 0, -1) ' Get all bytes from file
lngSize = len(strBuff)
flgFound = 0
strTarget = chr(255) & chr(216) & chr(255)
flgFound = instr(strBuff, strTarget)
if flgFound = 0 then
exit function
end if
strImageType = "JPG"
lngPos = flgFound + 2
ExitLoop = false
do while ExitLoop = False and lngPos < lngSize
do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
lngPos = lngPos + 1
loop
if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
lngPos = lngPos + lngMarkerSize + 1
else
ExitLoop = True
end if
loop
'
if ExitLoop = False then
Width = -1
Height = -1
Depth = -1
else
Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
gfxSpex = True
end if
end if
end function
FUNCTION fitImageInWindowWidth(imagename,cellwidth)
myImageFileName = imagename
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objF = objFSO.GetFolder(Server.Mappath("/images/"))
Set objFC = objF.Files
For Each f1 in objFC
if gfxSpex(Server.Mappath("/images/" & myImageFileName), w, h, c, strType) = true then
fitImageInWindowWidth = ("<img src='/images/" & myImageFileName & "' width='" & cellwidth & "' height='" & fix((h*cellwidth)/w) & "'>") ' & cellwidth & " x " & fix((h*cellwidth)/w))
end if
Next
set objFC = nothing
set objF = nothing
set objFSO = nothing
END FUNCTION
%>
and call the function by using code like this:
<%=fitImageInWindowWidth("image1.jpg",200)%>
This will make the image "image1.jpg" 200 pixels wide and scale the height proportionally. Change the image and pix size to whatever you desire.
Now this is assuming the images are in the "/images" folder off the root and this code is run from a page at the root level.
A coupla' points to make:
1. This code prioritizes width. It could be adapted to prioritize height.
2. AFAIK it only scales down. I've never tried it scaling up.
3. Currently works with JPG, GIF, PNG, and BMP file types but I'm hoping to add more soon.
4. It does not resize the image before being sent to the browser. The server sends the whole image and then the browser scales it. Hence, not really recommended for widespread use on Internet sites.
However, I have found that it is very responsive if you use it for a hi-res logo or something of that nature. Since most files are cached locally, once the logo is downloaded, most browser configs will use the cached copy so performance issues are negligible. Again tho, if you're using lots of hi-res images in lots of places, you will notice the download performance hits. The good news however is that since your image size is specified, most browsers will 'reserve' the space on the page while the image is downloading.
Again, I find this most helpful in Intranet sites and is very valuable if I just need to grab another 20 pix or so for another item on just 1 page. I just change the width parameter on the function call and it's done. Don't have to open any image editors etc.
Hope it helps someone.
|
|
|
|
