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

ReadyGo!技术成就梦想网络搜索 efish 2008-2-24 3:06:53

在网站前台产品展示时，一般用缩略图，点击进入然后看到大图。
缩略图带来了两个烦劳：
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 & " "
If InStr(sReturnInfo, "Error_") <= 0 Then
 sSmallPath = sReturnInfo "返回信息就是
 "将sSmallPath写入数据库
 "
Else
 Response.Write "详细错误:"
 Select Case sReturnInfo
 Case "Error_01"
 Response.Write "创建AspJpeg组件失败,没有正确安装注册该组件" & " "
 Case "Error_02"
 Response.Write "原图片不存在,检查s_OriginalPath参数传入值" & " "
 Case "Error_03"
 Response.Write "缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足" & " "
 Case "Error_Other"
 Response.Write "未知错误" & " "
 End Select
 Response.End
End If

%>
原文件名：<%=sOriginalPath%> 
缩略图文件名：<%=sSmallPath%> 
原图片：<img src="<%=sOriginalPath%>" border=0> 
缩略图：<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

责任编辑: efish 参与评论查找更多：

相关文章

asp连接数据库的方法(全) asp连接数据库的方法(全)

将内容自动添加到指定文本域的JS 将内容自动添加到指定文本域的JS

ASP二进制流方法隐藏图片文件真实地址 ASP二进制流方法隐藏图片文件真实地址

PRB：ASP 返回“Operation Must Use an Updateable … PRB：ASP 返回“Operation Must Use an Updateable Query”（操作必须使用可更新的查询）错误

对ASP动态包含文件方法的改进对ASP动态包含文件方法的改进

整站二进制数据库文件还原整站二进制数据库文件还原

实用的ASP连接数据库的函数实用的ASP连接数据库的函数

ASP提高数据显示效率-缓存探幽 ASP提高数据显示效率-缓存探幽

ASP日期和时间函数示例 ASP日期和时间函数示例

Access与Sql Server之ASP代码比较 Access与Sql Server之ASP代码比较

2秒记住本站域名

玩过泡泡龙吗？Readygo?Go! 再加上.Com.Cn的后缀，那就是大名小顶的ReadyGo.com.cn

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

2秒记住本站域名

分类导航