ASP change picture size ASP enlarge picture size ASP Shrink picture size

Enlarge

<%
Class dealimgsize
Dim aso
Private Sub Class_Initialize
Set Aso=createobject ("ADODB.stream")
Aso. Mode=3
Aso. Type=1
Aso. Open
End Sub
Private Sub Class_Terminate
Set aso=nothing
End Sub

Private Function bin2str (Bin)


Dim I, Str, Clow


for I=1 to LenB (Bin)


clow=midb (bin,i,1)


if ASCB (clow) &lt;128 then


str = str &amp; CHR (ASCB (Clow))


Else


i=i+1


if I &lt;= LenB (Bin) then str = str &amp; CHR (ASCW (MidB (bin,i,1) &amp;clow))


End If


Next


bin2str = Str


End Function


 


Private Function binval (BIN)


Dim Ret,i


ret = 0


for i = LenB (bin) to 1 step-1


ret = ret *256 + ASCB (MidB (bin,i,1))


Next


Binval=ret


End Function


 


Private Function BinVal2 (BIN)


Dim Ret,i


ret = 0


for i = 1 to LenB (BIN)


ret = ret *256 + ASCB (MidB (bin,i,1))


Next


Binval2=ret


End Function


 


Function getimagesize (filespec)


Dim ret (2), Bflag,p1


ASO. LoadFromFile (filespec)


Bflag=aso.read (3)


Select Case Hex (binval (bflag))


case "4E5089":


Aso.read (15)


ret (0) = "PNG"


RET (1) =binval2 (Aso.read (2))


Aso.read (2)


ret (2) =binval2 (Aso.read (2))


case "464947":


Aso.read (3)


ret (0) = "GIF"


ret (1) =binval (Aso.read (2))


ret (2) =binval (Aso.read (2))


case "FFD8FF":


do


Do:p1=binval (ASO. Read (1)): Loop while p1=255 and not ASO. EOS


if p1&gt;191 and p1&lt;196 then exit Do else Aso.read (binval2. Read (2))-2


Do:p1=binval (ASO. Read (1)): Loop while p1&lt;255 and not ASO. EOS


Loop While True


ASO. Read (3)


ret (0) = "JPG"


ret (2) =binval2 (ASO. Read (2))


ret (1) =binval2 (ASO. Read (2))


Case Else:


If left (Bin2str (Bflag), 2) = "BM" then


ASO. Read (15)


ret (0) = "BMP"


ret (1) =binval (ASO. Read (4))


ret (2) =binval (ASO. Read (4))


Else


ret (0) = ""


End If


End Select


Getimagesize=ret


End Function


 


Function Resize (OW,OH,RW,RH)


Dim wh (1)


if CInt (ow) &gt;cint (OH) then


if CInt (OW) &gt;cint (rw) then


WH (0) =RW


WH (1) =int (oh/(OW/RW))


Else


WH (0) =ow


WH (1) =oh


End If


Else


if CInt (OH) &gt;cint (RH) then


WH (0) =int (ow/(OH/RH))


WH (1) =rh


Else


WH (0) =ow


WH (1) =oh


End If


End If


RESIZE=WH


End Function


End Class


%&gt;

'********************

' Use method

'********************
<%
Dim AA
Set aa=new Dealimgsize
Dim Pw,ph,rpw,rph
Pw=aa.getimagesize (Server.MapPath ("01.jpg")) (1)
Ph=aa.getimagesize (Server.MapPath ("01.jpg")) (2)
Rpw=aa. Resize (pw,ph,160,120) (0)
Rph=aa. Resize (pw,ph,160,120) (1)
Response.Write ("Set aa=nothing
%>