分享
 
 
 

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

王朝asp·作者佚名  2006-12-16
窄屏简体版  字體: |||超大  

在网站前台产品展示时,一般用缩略图,点击进入然后看到大图。

缩略图带来了两个烦劳:

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=0><br/><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

%>

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有