用AspJpeg组件按宽高比例真正生成缩略图

【 tulaoshi.com - Web开发 】

　　在网站前台产品展示时，一般用缩略图，点击进入然后看到大图。
　　缩略图带来了两个烦劳：
　　1.如果后台只传一张大图，显示缩略图时只是将大图固定宽度和高度，这样不但造成缩略图变形，而且使得页面访问速度缓慢。
　　2.如果后台每次上传时，都上传两张图片，一张大图，一张缩略图。这样的话，没有1中的问题，但是给后台人员造成很大麻烦。因为后台人员并不一定知道处理生成缩略图；即使知道并能快速处理，也浪费掉一些时间。

　　下面的代码可以帮您用AspJpeg组件，按宽高比例，真正生成缩略图
　　AspJpeg组件下载：http://www.aspjpeg.com/download.html
　　AspJpeg组件使用：http://www.mydw.cn/tech/1/766.html
　　注册码：48958-77556-02411

　　%
　　Dim sOriginalPath
　　sOriginalPath = "images/1.gif"
　　'原图片路径一般上传完毕后获取，或者从数据库获取

　　Dim sReturnInfo, sSmallPath '函数返回信息, 缩略图路径
　　sReturnInfo = BuildSmallPic(sOriginalPath, "images", 100, 100)

　　Response.Write "返回信息:" & sReturnInfo & "br/"
　　If InStr(sReturnInfo, "Error_") = 0 Then
　　    sSmallPath = sReturnInfo '返回信息就是
　　    '将sSmallPath写入数据库
　　    '
　　Else
　　    Response.Write "详细错误:"
　　    Select Case sReturnInfo
　　    Case "Error_01"
　　        Response.Write "font color='red'创建AspJpeg组件失败,没有正确安装注册该组件/font" & "br/"
　　    Case "Error_02"
　　        Response.Write "font color='red'原图片不存在,检查s_OriginalPath参数传入值/font" & "br/"
　　    Case "Error_03"   
　　        Response.Write "font color='red'缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足/font" & "br/"
　　    Case "Error_Other"
　　        Response.Write "font color='red'未知错误/font" & "br/"
　　    End Select
　　    Response.End
　　End If

　　%
　　原文件名：%=sOriginalPath%br/
　　缩略图文件名：%=sSmallPath%br/
　　原图片：img src='%=sOriginalPath%' border=0br/br/
　　缩略图：img src='%=sSmallPath%' border=0

　　
　　%
　　'================================================================
　　'Author：laifangsong QQ:25313644
　　'功能：按照指定图片生成缩略图
　　'注意：以下提到的“路径”都是值相对于调用本函数的文件的相对路径
　　'参数：
　　'    s_OriginalPath:        原图片路径 例:images/image1.gif
　　'    s_BuildBasePath:    生成图片的基路径,不论是否以“/”结尾均可 例:images或images/
　　'    n_MaxWidth:            生成图片最大宽度
　　'                        如果在前台显示的缩略图是 100*100,这里 n_MaxWidth=100,n_MaxHeight=100.
　　'    n_MaxHeight:        生成图片最大高度
　　'返回值：
　　'    返回生成后的缩略图的路径
　　'错误处理：
　　'    如果函数执行过程中出现错误,将返回错误代码,错误代码以 “Error”开头
　　'        Error_01:创建AspJpeg组件失败,没有正确安装注册该组件
　　'        Error_02:原图片不存在,检查s_OriginalPath参数传入值
　　'        Error_03:缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足
　　'        Error_Other:未知错误
　　'调用例子:
　　'    Dim sSmallPath '缩略图路径
　　'    sSmallPath = BuildSmallPic("images/image1.gif", "images", 100, 100)   
　　'================================================================
　　Function BuildSmallPic(s_OriginalPath, s_BuildBasePath, n_MaxWidth, n_MaxHeight)
　　    Err.Clear
　　    On Error Resume Next
　　   
　　    '检查组件是否已经注册
　　    Dim AspJpeg
　　    Set AspJpeg = Server.Createobject("Persits.Jpeg")
　　    If Err.Number 0 Then
　　        Err.Clear
　　        BuildSmallPic = "Error_01"
　　        Exit Function
　　    End If

　　    '检查原图片是否存在
　　    Dim s_MapOriginalPath
　　    s_MapOriginalPath = Server.MapPath(s_OriginalPath)
　　    AspJpeg.Open s_MapOriginalPath '打开原图片
　　    If Err.Number 0 Then
　　        Err.Clear
　　        BuildSmallPic = "Error_02"
　　        Exit Function
　　    End If

　　    '按比例取得缩略图宽度和高度
　　    Dim n_OriginalWidth, n_OriginalHeight '原图片宽度、高度
　　    Dim n_BuildWidth, n_BuildHeight '缩略图宽度、高度
　　    Dim div1, div2
　　    Dim n1, n2
　　    n_OriginalWidth = AspJpeg.Width
　　    n_OriginalHeight = AspJpeg.Height
　　    div1 = n_OriginalWidth / n_OriginalHeight
　　    div2 = n_OriginalHeight / n_OriginalWidth
　　    n1 = 0
　　    n2 = 0
　　    If n_OriginalWidth n_MaxWidth Then
　　        n1 = n_OriginalWidth / n_MaxWidth
　　    Else
　　        n_BuildWidth = n_OriginalWidth
　　    End If
　　    If n_OriginalHeight n_MaxHeight Then
　　        n2 = n_OriginalHeight / n_MaxHeight
　　    Else
　　        n_BuildHeight = n_OriginalHeight
　　    End If
　　    If n1 0 Or n2 0 Then
　　        If n1 n2 Then
　　            n_BuildWidth = n_MaxWidth
　　            n_BuildHeight = n_MaxWidth * div2
　　        Else
　　            n_BuildWidth = n_MaxHeight * div1
　　            n_BuildHeight = n_MaxHeight
　　        End If
　　    End If

　　    '指定宽度和高度生成
　　    AspJpeg.Width = n_BuildWidth
　　    AspJpeg.Height = n_BuildHeight
　　   
　　    '--将缩略图存盘开始--
　　    Dim pos, s_OriginalFileName, s_OriginalFileExt '位置、原文件名、原文件扩展名
　　    pos = InStrRev(s_OriginalPath, "/") + 1
　　    s_OriginalFileName = Mid(s_OriginalPath, pos)
　　    pos = InStrRev(s_OriginalFileName, ".")
　　    s_OriginalFileExt = Mid(s_OriginalFileName, pos)

　　    Dim s_MapBuildBasePath, s_MapBuildPath, s_BuildFileName '缩略图绝对路径、缩略图文件名
　　    Dim s_EndFlag '小图片文件名结尾标识 例: 如果大图片文件名是“image1.gif”,结尾标识是“_small”,那么小图片文件名就是“image1_small.gif”
　　    If Right(s_BuildBasePath, 1) "/" Then s_BuildBasePath = s_BuildBasePath & "/"
　　    s_MapBuildBasePath = Server.MapPath(s_BuildBasePath)
　　    s_EndFlag = "_small" '可以自定义,只要能区别大小图片即可
　　    s_BuildFileName = Replace(s_OriginalFileName, s_OriginalFileExt, "") & s_EndFlag & s_OriginalFileExt
　　    s_MapBuildPath = s_MapBuildBasePath & "" & s_BuildFileName
　　   
　　    AspJpeg.Save s_MapBuildPath '保存
　　    If Err.Number 0 Then
　　        Err.Clear
　　        BuildSmallPic = "Error_03"
　　        Exit Function
　　    End If
　　    '--将缩略图存盘结束--

　　    '注销实例
　　    Set AspJpeg = Nothing
　　    If Err.Number 0 Then
　　        BuildSmallPic = "Error_Other"
　　        Err.Clear
　　    End If
　　    BuildSmallPic = s_BuildBasePath & s_BuildFileName
　　End Function

　　%