Image Re size in ASP
--------------------------------------------------
Create propresize.asp with the following code
<%
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: SCRIPT: PropResize :::
'::: AUTHOR: Mike Shaffer :::
'::: DATE: 03-May-2000 :::
'::: PURPOSE: Creates a WIDTH/HEIGHT parameter string :::
'::: (for use with the <IMG...> tag to allow :::
'::: for proportional resizing :::
'::: NOTE: Requires routines found in IMGSZ.ASP :::
'::: http://www.4guysfromrolla.com/webtech/050300-1.shtml :::
'::: :::
function ImageResize(strImageName, intDesiredWidth, intDesiredHeight)
dim TargetRatio
dim CurrentRatio
dim strResize
dim w, h, c, strType
if gfxSpex(strImageName, w, h, c, strType) = true then
TargetRatio = intDesiredWidth / intDesiredHeight
CurrentRatio = w / h
if CurrentRatio > TargetRatio then ' We'll scale height
strResize = "width=""" & intDesiredWidth & """"
else
strResize = "height=""" & intDesiredHeight & """"
' We'll scale width
end if
else
strResize = ""
end if
ImageResize = strResize
end Function
%>
----------------------------------------------------------------
Create imgsz.asp with the following code
<%
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This routine will attempt to identify any filespec passed :::
'::: as a graphic file (regardless of the extension). This will :::
'::: work with BMP, GIF, JPG and PNG files. :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: Based on ideas presented by David Crowell :::
'::: (credit where due) :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This function gets a specified number of bytes from any :::
'::: file, starting at the offset (base 1) :::
'::: :::
'::: Passed: :::
'::: flnm => Filespec of file to read :::
'::: offset => Offset at which to start reading :::
'::: bytes => How many bytes to read :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function GetBytes(flnm, offset, bytes)
Dim objFSO
Dim objFTemp
Dim objTextStream
Dim lngSize
dim fsoForReading
on error resume next
Set objFSO = CreateObject("Scripting.FileSystemObject")
' First, we get the filesize
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
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: Functions to convert two bytes to a numeric value (long) :::
'::: (both little-endian and big-endian) :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
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
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This function does most of the real work. It will attempt :::
'::: to read any file, regardless of the extension, and will :::
'::: identify if it is a graphical image. :::
'::: :::
'::: Passed: :::
'::: flnm => Filespec of file to read :::
'::: width => width of image :::
'::: height => height of image :::
'::: depth => color depth (in number of colors) :::
'::: strImageType=> type of image (e.g. GIF, BMP, etc.) :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function gfxSpex(flnm, width, height, depth, strImageType)
dim strPNG
dim strGIF
dim strBMP
dim strType
dim strBuff
dim lngSize
dim flgFound
dim strTarget
dim lngPos
dim ExitLoop
dim lngMarkerSize
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
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: Test Harness :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
' To test, we'll just try to show all files with a .GIF extension in the root of C:
'Set objFSO = CreateObject("Scripting.FileSystemObject")
' Set objF = objFSO.GetFolder("D:\projects\goh-new\images\")
' Set objFC = objF.Files
' response.write "<table border=""0"" cellpadding=""5"">"
' For Each f1 in objFC
' if instr(ucase(f1.Name), ".JPG") then
' response.write "<tr><td>" & f1.name & "</td><td>" & f1.DateCreated & "</td><td>" & f1.Size & "</td><td>"
' if gfxSpex(f1.Path, w, h, c, strType) = true then
' response.write w & " x " & h & " " & c & " colors"
' else
' response.write " "
' end if
' response.write "</td></tr>"
' end if
' Next
' response.write "</table>"
' set objFC = nothing
' set objF = nothing
' set objFSO = nothing
%>
----------------------------------------------------------------
Include the Above created files
<!-- #include virtual="/includes/propresize.asp" -->
<!-- #include virtual="/includes/imgsz.asp" -->
Call ImageResize function like the below
<img src="/images/image1.jpg"<%=ImageResize(Server.MapPath("/images/image1.jp"),200,133)%>>
Helpful Code
<!--#INCLUDE FILE="imgsz.asp"-->
<!--#INCLUDE FILE="propresize.asp"-->
<%
' To test, we'll just try to show all files with a .GIF extension in
' the root of C: by fitting them to a common area (75 pixels x 45 pixels)
dim objFSO, objF, objFC
dim f1, w, h, c, strType
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objF = objFSO.GetFolder(Server.MapPath("/images/"))
Set objFC = objF.Files
response.write "<table border=""1"" cellpadding=""5"">"
For Each f1 in objFC
if instr(ucase(f1.Name), ".JPG") then
response.write "<tr><td>" & f1.name & "</td><td>" & f1.DateCreated & _
"</td><td>" & f1.Size & "</td><td>"
if gfxSpex(f1.Path, w, h, c, strType) = true then
response.write w & " x " & h & " " & c & " colors</td>"
response.write "<td><img src=""/images/" & f1.Name & """ " & _
ImageResize(f1.Path, 75, 45) & " border=""1""></td>"
else
response.write " </td><td align=""center"">bad image</td>"
end if
response.write "</tr>"
end if
Next
response.write "</table>"
set objFC = nothing
set objF = nothing
set objFSO = nothing
%>
Source:
