适用版本 v5.5正式版,需要aspjpeg组件支持。
使用方便,在哪里调用,就实时生成一个缩略图,生成路径与原图相同,在文件名后面自动加尺寸如: _48x48
需要注意的是被缩略的图片尺寸要比缩略尺寸大,这次缩出来的图片才好看。
缩略的方法是先按比例缩,然后取中间的图像,保证图片尺寸完全符合要求。
另外建议关闭程序的缩略图功能。
调用方法,在自定义SQL标签里调一下标签
{$Thumbnails({$Field(PicUrl,Text,0,0,2,)},120,90)}
'参说说明:参数1是为原图片地址,参数2是缩略图宽度,参数3是缩略图高度
代码如下:
修改KS_Cls\Kesion.Label.SQLCls.asp 这个文件
在大约350行左右 End Function 前一行加入 GetCirLabelContent=MyThumbnails(GetCirLabelContent)
然后在End Function 下面输入一下函数
函数中的网址是为了保证启用二级域名后图片依然能从www目录下读取,不需要的朋友可以把这个去掉
============这个是解析标签的函数
'示例:{$Thumbnails({$Field(PicUrl,Text,0,0,2,)},120,90)}
'参说说明:参数1是为原图片地址,参数2是缩略图宽度,参数3是缩略图高度
Function MyThumbnails(lpFieldValue)
On Error Resume Next
Dim regEx, Matches, Match
Dim FieldParam,FieldParamArr,mytempValue,mytempNum,mytarget,templpFieldValue,MakeResult,ThumbnailsPath,PicPathNoUrl,PicWidth,PicHeight
Set regEx = New RegExp
regEx.Pattern = "{\$Thumbnails\([^{\$}]*}"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(lpFieldValue)
For Each Match In Matches
FieldParam = Replace(Replace(Match.Value,"{$Thumbnails(",""),")}","")
FieldParamArr = Split(FieldParam,",")
PicPathNoUrl = Replace(FieldParamArr(0),"http://www.kmhao.com","")
PicWidth=FieldParamArr(1)
PicHeight=FieldParamArr(2)
mytempValue=split(PicPathNoUrl,".")
ThumbnailsPath=mytempValue(0)&"_"&PicWidth&"x"&PicHeight&"."&mytempValue(1)
lpFieldValue=Replace(lpFieldValue,Match.Value,"http://www.kmhao.com"&ThumbnailsPath)
MakeResult=MakeThumbnails(PicPathNoUrl,PicWidth,PicHeight)
Next
MyThumbnails=lpFieldValue
End Function
在最后一行end class后面 加
这个是缩略图的函数,
'===================================================
Function MakeThumbnails(PicUrl,PicWidth,PicHeight)
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_MapPicPath
s_MapPicPath = Server.MapPath(PicUrl)
AspJpeg.Open s_MapPicPath '打开原图片
If Err.Number <> 0 Then
Err.Clear
BuildSmallPic = "Error_02"
Exit Function
End If
Dim strArr,PicToUrl,PicName,PicToPath
strArr=Split(PicUrl,".")
PicToUrl=strArr(0)&"_"&PicWidth&"x"&PicHeight&"."&strArr(1)
strArr=Split(PicUrl,"/")
PicName=strArr(Ubound(strArr))
PicToPath=Replace(PicUrl,PicName,"")
'按比例取得缩略图宽度和高度
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 = PicWidth / PicHeight
n1 = 0
n2 = 0
If n_OriginalWidth > PicWidth Then
n1 = n_OriginalWidth / PicWidth
Else
n_BuildWidth = n_OriginalWidth
End If
If n_OriginalHeight > PicHeight Then
n2 = n_OriginalHeight / PicHeight
Else
n_BuildHeight = n_OriginalHeight
End If
If div1=div2 Then
n_BuildWidth = PicWidth
n_BuildHeight = PicHeight
End If
If div1>div2 Then
n_BuildWidth = n_OriginalWidth/(n_OriginalHeight/PicHeight)
n_BuildHeight = PicHeight
End If
If div1<div2 Then
n_BuildWidth = PicWidth
n_BuildHeight = n_OriginalHeight/(n_OriginalWidth/PicWidth)
End If
'指定宽度和高度生成
AspJpeg.Width = n_BuildWidth
AspJpeg.Height = n_BuildHeight
'缩略后裁剪
Dim BCropX,BCropY
BCropX=0
BCropY=0
If Int(n_BuildWidth) > Int(PicWidth) Then
BCropX=Int((n_BuildWidth-PicWidth)/2)
End If
If Int(n_BuildHeight) > Int(PicHeight) Then
BCropY=Int((n_BuildHeight-PicHeight)/2)
End If
AspJpeg.Crop BCropX, BCropY, PicWidth+BCropX, PicHeight+BCropY
AspJpeg.Save Server.MapPath(PicToUrl)
MakeThumbnails="OK"
Set AspJpeg = Nothing
End Function