Shrink pictures proportionally (no components)

<%


Class Possible


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


for I=1 to LenB (Bin)


clow=midb (bin,i,1)


if ASCB (clow) <128 then


str = str & CHR (ASCB (Clow))


Else


i=i+1


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


End If


Next


bin2str = Str


End Function





Private Function num2str (num,base,lens)


Dim ret


ret = ""


while (num>=base)


ret = (num mod base) & ret


num = (num-num mod base)/base


Wend


Num2str = Right (string (lens, "0") & Num & Ret,lens)


End Function





Private Function str2num (str,base)


Dim ret


ret = 0


for I=1 to Len (str)


ret = ret *base + CInt (Mid (str,i,1))


Next


Str2num=ret


End Function





Private Function binval (BIN)


Dim ret


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


ret = 0


for i = 1 to LenB (BIN)


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


Next


Binval2=ret


End Function





Private Function getimagesize (filespec)


Dim ret (3)


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))