在网站前台产品展示时,一般用缩略图,点击进入然后看到大图。
缩略图带来了两个烦劳:
1.如果后台只传一张大图,显示缩略图时只是将大图固定宽度和高度,这样不但造成缩略图变形,而且使得页面访问速度缓慢。
2.如果后台每次上传时,都上传两张图片,一张大图,一张缩略图。这样的话,没有1中的问题,但是给后台人员造成很大麻烦。因为后台人员并不一定知道处理生成缩略图;即使知道并能快速处理,也浪费掉一些时间。
下面的代码可以帮您用AspJpeg组件,按宽高比例,真正生成缩略图
AspJpeg组件下载:http://www.aspjpeg.com/download.html
AspJpeg组件使用:http://www.mydw.cn/tech/1/766.html
注册码:48958-77556-02411
1
<%
2
Dim sOriginalPath
3
sOriginalPath = "images/1.gif"
4
'原图片路径一般上传完毕后获取,或者从数据库获取
5
6
Dim sReturnInfo, sSmallPath '函数返回信息, 缩略图路径
7
sReturnInfo = BuildSmallPic(sOriginalPath, "images", 100, 100)
8
9
Response.Write "返回信息:" & sReturnInfo & "<br/>"
10
If InStr(sReturnInfo, "Error_") <= 0 Then
11
sSmallPath = sReturnInfo '返回信息就是
12
'将sSmallPath写入数据库
13
'
14
Else
15
Response.Write "详细错误:"
16
Select Case sReturnInfo
17
Case "Error_01"
18
Response.Write "<font color='red'>创建AspJpeg组件失败,没有正确安装注册该组件</font>" & "<br/>"
19
Case "Error_02"
20
Response.Write "<font color='red'>原图片不存在,检查s_OriginalPath参数传入值</font>" & "<br/>"
21
Case "Error_03"
22
Response.Write "<font color='red'>缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足</font>" & "<br/>"
23
Case "Error_Other"
24
Response.Write "<font color='red'>未知错误</font>" & "<br/>"
25
End Select
26
Response.End
27
End If
28
29
%>
30
原文件名:<%=sOriginalPath%><br/>
31
缩略图文件名:<%=sSmallPath%><br/>
32
原图片:<img src='<%=sOriginalPath%>' border=0><br/><br/>
33
缩略图:<img src='<%=sSmallPath%>' border=0>
34
35
36
<%
37
'================================
38
'Author:laifangsong QQ:25313644
39
'功能:按照指定图片生成缩略图
40
'注意:以下提到的“路径”都是值相对于调用本函数的文件的相对路径
41
'参数:
42
' s_OriginalPath: 原图片路径 例:images/image1.gif
43
' s_BuildBasePath: 生成图片的基路径,不论是否以“/”结尾均可 例:images或images/
44
' n_MaxWidth: 生成图片最大宽度
45
' 如果在前台显示的缩略图是 100*100,这里 n_MaxWidth=100,n_MaxHeight=100.
46
' n_MaxHeight: 生成图片最大高度
47
'返回值:
48
' 返回生成后的缩略图的路径
49
'错误处理:
50
' 如果函数执行过程中出现错误,将返回错误代码,错误代码以 “Error”开头
51
' Error_01:创建AspJpeg组件失败,没有正确安装注册该组件
52
' Error_02:原图片不存在,检查s_OriginalPath参数传入值
53
' Error_03:缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足
54
' Error_Other:未知错误
55
'调用例子:
56
' Dim sSmallPath '缩略图路径
57
' sSmallPath = BuildSmallPic("images/image1.gif", "images", 100, 100)
58
'================================================================
59
Function BuildSmallPic(s_OriginalPath, s_BuildBasePath, n_MaxWidth, n_MaxHeight)
60
Err.Clear
61
On Error Resume Next
62
63
'检查组件是否已经注册
64
Dim AspJpeg
65
Set AspJpeg = Server.Createobject("Persits.Jpeg")
66
If Err.Number <> 0 Then
67
Err.Clear
68
BuildSmallPic = "Error_01"
69
Exit Function
70
End If
71
72
'检查原图片是否存在
73
Dim s_MapOriginalPath
74
s_MapOriginalPath = Server.MapPath(s_OriginalPath)
75
AspJpeg.Open s_MapOriginalPath '打开原图片
76
If Err.Number <> 0 Then
77
Err.Clear
78
BuildSmallPic = "Error_02"
79
Exit Function
80
End If
81
82
'按比例取得缩略图宽度和高度
83
Dim n_OriginalWidth, n_OriginalHeight '原图片宽度、高度
84
Dim n_BuildWidth, n_BuildHeight '缩略图宽度、高度
85
Dim div1, div2
86
Dim n1, n2
87
n_OriginalWidth = AspJpeg.Width
88
n_OriginalHeight = AspJpeg.Height
89
div1 = n_OriginalWidth / n_OriginalHeight
90
div2 = n_OriginalHeight / n_OriginalWidth
91
n1 = 0
92
n2 = 0
93
If n_OriginalWidth > n_MaxWidth Then
94
n1 = n_OriginalWidth / n_MaxWidth
95
Else
96
n_BuildWidth = n_OriginalWidth
97
End If
98
If n_OriginalHeight > n_MaxHeight Then
99
n2 = n_OriginalHeight / n_MaxHeight
100
Else
101
n_BuildHeight = n_OriginalHeight
102
End If
103
If n1 <> 0 Or n2 <> 0 Then
104
If n1 > n2 Then
105
n_BuildWidth = n_MaxWidth
106
n_BuildHeight = n_MaxWidth * div2
107
Else
108
n_BuildWidth = n_MaxHeight * div1
109
n_BuildHeight = n_MaxHeight
110
End If
111
End If
112
113
'指定宽度和高度生成
114
AspJpeg.Width = n_BuildWidth
115
AspJpeg.Height = n_BuildHeight
116
117
'--将缩略图存盘开始--
118
Dim pos, s_OriginalFileName, s_OriginalFileExt '位置、原文件名、原文件扩展名
119
pos = InStrRev(s_OriginalPath, "/") + 1
120
s_OriginalFileName = Mid(s_OriginalPath, pos)
121
pos = InStrRev(s_OriginalFileName, ".")
122
s_OriginalFileExt = Mid(s_OriginalFileName, pos)
123
124
Dim s_MapBuildBasePath, s_MapBuildPath, s_BuildFileName '缩略图绝对路径、缩略图文件名
125
Dim s_EndFlag '小图片文件名结尾标识 例: 如果大图片文件名是“image1.gif”,结尾标识是“_small”,那么小图片文件名就是“image1_small.gif”
126
If Right(s_BuildBasePath, 1) <> "/" Then s_BuildBasePath = s_BuildBasePath & "/"
127
s_MapBuildBasePath = Server.MapPath(s_BuildBasePath)
128
s_EndFlag = "_small" '可以自定义,只要能区别大小图片即可
129
s_BuildFileName = Replace(s_OriginalFileName, s_OriginalFileExt, "") & s_EndFlag & s_OriginalFileExt
130
s_MapBuildPath = s_MapBuildBasePath & "\" & s_BuildFileName
131
132
AspJpeg.Save s_MapBuildPath '保存
133
If Err.Number <> 0 Then
134
Err.Clear
135
BuildSmallPic = "Error_03"
136
Exit Function
137
End If
138
'--将缩略图存盘结束--
139
140
'注销实例
141
Set AspJpeg = Nothing
142
If Err.Number <> 0 Then
143
BuildSmallPic = "Error_Other"
144
Err.Clear
145
End If
146
BuildSmallPic = s_BuildBasePath & s_BuildFileName
147
End Function
148
149
%>
150
<%2
Dim sOriginalPath3
sOriginalPath = "images/1.gif"4
'原图片路径一般上传完毕后获取,或者从数据库获取5

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

9
Response.Write "返回信息:" & sReturnInfo & "<br/>"10
If InStr(sReturnInfo, "Error_") <= 0 Then11
sSmallPath = sReturnInfo '返回信息就是 12
'将sSmallPath写入数据库13
'14
Else15
Response.Write "详细错误:" 16
Select Case sReturnInfo17
Case "Error_01"18
Response.Write "<font color='red'>创建AspJpeg组件失败,没有正确安装注册该组件</font>" & "<br/>"19
Case "Error_02"20
Response.Write "<font color='red'>原图片不存在,检查s_OriginalPath参数传入值</font>" & "<br/>"21
Case "Error_03" 22
Response.Write "<font color='red'>缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足</font>" & "<br/>"23
Case "Error_Other"24
Response.Write "<font color='red'>未知错误</font>" & "<br/>"25
End Select26
Response.End27
End If28

29
%>30
原文件名:<%=sOriginalPath%><br/>31
缩略图文件名:<%=sSmallPath%><br/>32
原图片:<img src='<%=sOriginalPath%>' border=0><br/><br/>33
缩略图:<img src='<%=sSmallPath%>' border=0>34

35

36
<%37
'================================38
'Author:laifangsong QQ:2531364439
'功能:按照指定图片生成缩略图40
'注意:以下提到的“路径”都是值相对于调用本函数的文件的相对路径41
'参数:42
' s_OriginalPath: 原图片路径 例:images/image1.gif43
' s_BuildBasePath: 生成图片的基路径,不论是否以“/”结尾均可 例:images或images/44
' n_MaxWidth: 生成图片最大宽度45
' 如果在前台显示的缩略图是 100*100,这里 n_MaxWidth=100,n_MaxHeight=100.46
' n_MaxHeight: 生成图片最大高度47
'返回值:48
' 返回生成后的缩略图的路径49
'错误处理:50
' 如果函数执行过程中出现错误,将返回错误代码,错误代码以 “Error”开头51
' Error_01:创建AspJpeg组件失败,没有正确安装注册该组件52
' Error_02:原图片不存在,检查s_OriginalPath参数传入值53
' Error_03:缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足54
' Error_Other:未知错误55
'调用例子:56
' Dim sSmallPath '缩略图路径57
' sSmallPath = BuildSmallPic("images/image1.gif", "images", 100, 100) 58
'================================================================59
Function BuildSmallPic(s_OriginalPath, s_BuildBasePath, n_MaxWidth, n_MaxHeight)60
Err.Clear61
On Error Resume Next62
63
'检查组件是否已经注册64
Dim AspJpeg65
Set AspJpeg = Server.Createobject("Persits.Jpeg")66
If Err.Number <> 0 Then67
Err.Clear68
BuildSmallPic = "Error_01"69
Exit Function70
End If71

72
'检查原图片是否存在73
Dim s_MapOriginalPath74
s_MapOriginalPath = Server.MapPath(s_OriginalPath)75
AspJpeg.Open s_MapOriginalPath '打开原图片76
If Err.Number <> 0 Then77
Err.Clear78
BuildSmallPic = "Error_02"79
Exit Function80
End If81

82
'按比例取得缩略图宽度和高度83
Dim n_OriginalWidth, n_OriginalHeight '原图片宽度、高度84
Dim n_BuildWidth, n_BuildHeight '缩略图宽度、高度85
Dim div1, div286
Dim n1, n287
n_OriginalWidth = AspJpeg.Width88
n_OriginalHeight = AspJpeg.Height89
div1 = n_OriginalWidth / n_OriginalHeight90
div2 = n_OriginalHeight / n_OriginalWidth91
n1 = 092
n2 = 093
If n_OriginalWidth > n_MaxWidth Then94
n1 = n_OriginalWidth / n_MaxWidth95
Else96
n_BuildWidth = n_OriginalWidth97
End If98
If n_OriginalHeight > n_MaxHeight Then99
n2 = n_OriginalHeight / n_MaxHeight100
Else101
n_BuildHeight = n_OriginalHeight102
End If103
If n1 <> 0 Or n2 <> 0 Then104
If n1 > n2 Then105
n_BuildWidth = n_MaxWidth106
n_BuildHeight = n_MaxWidth * div2107
Else108
n_BuildWidth = n_MaxHeight * div1109
n_BuildHeight = n_MaxHeight110
End If111
End If112

113
'指定宽度和高度生成114
AspJpeg.Width = n_BuildWidth115
AspJpeg.Height = n_BuildHeight116
117
'--将缩略图存盘开始--118
Dim pos, s_OriginalFileName, s_OriginalFileExt '位置、原文件名、原文件扩展名119
pos = InStrRev(s_OriginalPath, "/") + 1120
s_OriginalFileName = Mid(s_OriginalPath, pos)121
pos = InStrRev(s_OriginalFileName, ".")122
s_OriginalFileExt = Mid(s_OriginalFileName, pos)123

124
Dim s_MapBuildBasePath, s_MapBuildPath, s_BuildFileName '缩略图绝对路径、缩略图文件名125
Dim s_EndFlag '小图片文件名结尾标识 例: 如果大图片文件名是“image1.gif”,结尾标识是“_small”,那么小图片文件名就是“image1_small.gif”126
If Right(s_BuildBasePath, 1) <> "/" Then s_BuildBasePath = s_BuildBasePath & "/"127
s_MapBuildBasePath = Server.MapPath(s_BuildBasePath)128
s_EndFlag = "_small" '可以自定义,只要能区别大小图片即可129
s_BuildFileName = Replace(s_OriginalFileName, s_OriginalFileExt, "") & s_EndFlag & s_OriginalFileExt130
s_MapBuildPath = s_MapBuildBasePath & "\" & s_BuildFileName131
132
AspJpeg.Save s_MapBuildPath '保存133
If Err.Number <> 0 Then134
Err.Clear135
BuildSmallPic = "Error_03"136
Exit Function137
End If138
'--将缩略图存盘结束--139

140
'注销实例141
Set AspJpeg = Nothing142
If Err.Number <> 0 Then143
BuildSmallPic = "Error_Other"144
Err.Clear145
End If146
BuildSmallPic = s_BuildBasePath & s_BuildFileName147
End Function148

149
%>150



浙公网安备 33010602011771号