本来是无组件图片文本混合上传,图片存文件夹文件名和文本存在数据库读取显示时用css固定尺寸来显示图片.
现在需要用jpeg组件把所有图片都生存缩略图并加水印,以后再添加的话自动能生存缩略图.
请高手指点.
------解决方案--------------------
文字水印：
Set Jpeg = Server.CreateObject( "Persits.Jpeg ") ' 建立对象
Jpeg.Open Server.MapPath(FileName) ' 图片所在位置
Jpeg.Canvas.Font.Color = &H000000 ' 颜色,这里是设置成:黑
Jpeg.Canvas.Font.Family = "方正隶变简体 " ' 设置字体
Jpeg.Canvas.Font.Bold = False '是否设置成粗体
Jpeg.Canvas.Font.Size = 50 '字体大小
Jpeg.Canvas.Font.Quality = 10 ' 文字清晰度
Jpeg.Canvas.Print Jpeg.OriginalWidth/2-170,Jpeg.OriginalHeight-50, "WWW.1983y.net.cn " '水印文字
Jpeg.Save Server.MapPath(FileName) ' 保存文件
Set Jpeg = Nothing
图片水印：
Set Jpeg1 = Server.CreateObject( "Persits.Jpeg ")
Set Jpeg2 = Server.CreateObject( "Persits.Jpeg ")
Jpeg1.Open Server.MapPath(file1)
Jpeg2.Open Server.MapPath(file2)
Jpeg1.Canvas.DrawImage Jpeg1.OriginalWidth-200,Jpeg1.OriginalHeight-50, Jpeg2,0.8 ' optional arguments omitted
'Jpeg1.Sharpen 1, 120
jpeg1.save Server.mappath( "sy.jpg ")
set Jpeg1 = nothig : set Jpeg2 = nothing
------解决方案--------------------
'*********************************
'生成缩略图片并剪裁成固定大小
'*********************************
Function getSmallPic(width,height,picPath)
On Error Resume Next
Dim Jpeg,picName '//声明变量
If InstrRev(picPath, "/ ")> 0 Then
picName=Mid(picPath,InstrRev(picPath, "/ ")+1,Len(picPath)-InstrRev(picPath, "/ "))
Else
picName=picPath
End If
picName= "/small/ "&CStr(width)& "_ "&CStr(height)& "_ "&picName
Dim fso
Set fso = Server.Createobject(DEF_FSOString)
If Not fso.FileExists(Server.MapPath(picName)) Then
Set Jpeg = Server.CreateObject( "Persits.Jpeg ") '//调用组件
Jpeg.Open Server.MapPath( "/ "&picPath) '//原图位置
Jpeg.Width = width '//设图片宽度
Jpeg.Height = CInt(jpeg.OriginalHeight*(width/jpeg.Originalwidth)) '//等比例缩放高度
If CInt(jpeg.Originalwidth) > CInt(width) Then
jpeg.crop 0,0,width,height '开始切割其实是把超过象素的下部分去掉
End If
Jpeg.Sharpen 1, 130 '//设定锐化效果
Jpeg.Save Server.MapPath(picName) '//生成缩略图位置及名称
Set Jpeg = Nothing '//注销组件，释放资源
End If
Set fso = Nothing
End Function