28,391
社区成员
发帖
与我相关
我的任务
分享ASPJPEG按比例缩放并按指定大小裁剪修改
按比例缩放并按指定大小裁剪（原代码是，竖的要剪掉上下部分，模的，要剪掉左右部分，模的可以接受这样，但竖的不行）
求修改-比如竖板的人物图片裁剪成方形成把头和脚都载了，能否修改成载掉图片下面部分保留上部分
function cutjpeg(byval cutfile,byval cwidth,byval cheight)
if not aspjpegobj or lcase(left(cutfile,7)) = "http://" then cutjpeg = cutfile :exit function
dim savefolder,savefile
savefolder = installdir & "uploadfile/small/" & replace(replace(replace(replace(lcase(cutfile),".jpg",""),"/",""),"uploadfile",""),".jpeg","") & "/"
savefile = savefolder & cwidth & "x" & cheight & ".jpg"
if fso.fileexists(server.mappath(savefile)) then
cutjpeg = savefile
Jpeg.Quality=100
else
dim jpeg
dim jwidth,jheight,nwidth,nheight
dim x1,y1,x2,y2
on error resume next
set jpeg = server.createobject(strobjectjpeg)
jpeg.regkey = "48958-77556-02411"
jpeg.open server.mappath(cutfile)
jwidth = jpeg.originalwidth
jheight = jpeg.originalheight
if (jwidth/jheight)>=(cwidth/cheight) then
nwidth=cint((jwidth/jheight)*cheight):nheight=cheight
jpeg.width=nwidth:jpeg.height=nheight
x1=int((nwidth-cwidth)/2):y1=0:x2=x1+cwidth:y2=cheight
else
nwidth=cwidth:nheight=cint((jheight/jwidth)*cwidth)
jpeg.width=nwidth:jpeg.height=nheight
x1=0:y1=int((nheight-cheight)/2):x2=cwidth:y2=y1+cheight
end if
jpeg.crop x1,y1,x2,y2
jpeg.sharpen 1,130
call createfolder(savefile) ' 需要带个文件才可生成
jpeg.save server.mappath(savefile)
set jpeg = nothing
if err then
cutjpeg = cutfile : err.clear
else
cutjpeg = savefile
end if
end if
end function
求修改-比如竖板的人物图片裁剪成方形成把头和脚都载了，能否修改成载掉图片下面部分保留上部分
function cutjpeg(byval cutfile,byval cwidth,byval cheight)
if not aspjpegobj or lcase(left(cutfile,7)) = "http://" then cutjpeg = cutfile :exit function
dim savefolder,savefile
savefolder = installdir & "uploadfile/small/" & replace(replace(replace(replace(lcase(cutfile),".jpg",""),"/",""),"uploadfile",""),".jpeg","") & "/"
savefile = savefolder & cwidth & "x" & cheight & ".jpg"
if fso.fileexists(server.mappath(savefile)) then
cutjpeg = savefile
Jpeg.Quality=100
else
dim jpeg
dim jwidth,jheight,nwidth,nheight
dim x1,y1,x2,y2
on error resume next
set jpeg = server.createobject(strobjectjpeg)
jpeg.regkey = "48958-77556-02411"
jpeg.open server.mappath(cutfile)
jwidth = jpeg.originalwidth
jheight = jpeg.originalheight
if (jwidth/jheight)>=(cwidth/cheight) then
nwidth=cint((jwidth/jheight)*cheight):nheight=cheight
jpeg.width=nwidth:jpeg.height=nheight
x1=int((nwidth-cwidth)/2):y1=0:x2=x1+cwidth:y2=cheight
else
nwidth=cwidth:nheight=cint((jheight/jwidth)*cwidth)
jpeg.width=nwidth:jpeg.height=nheight
x1=0:y1=int((nheight-cheight)/2):x2=cwidth:y2=y1+cheight
end if
jpeg.crop x1,y1,x2,y2
jpeg.sharpen 1,130
call createfolder(savefile) ' 需要带个文件才可生成
jpeg.save server.mappath(savefile)
set jpeg = nothing
if err then
cutjpeg = cutfile : err.clear
else
cutjpeg = savefile
end if
end if
end function
...全文
请发表友善的回复…
发表回复
bowbogcy 2013-08-04
- 打赏
- 举报
修改了半天，没有成功，请大师能否再明白一点[/quote]
已经解释的很明白了吧
jpeg.crop x1,y1,x2,y2
里面的前面x1,y1 这个2个参数改成0,0他就会是保留上面部分了，当然主要是y1这个参数是控制上下的，x1主要是控制左右的
你只要针对x1,y1进行调整，也就是这个2个参数值控制从哪里开始切割裁剪，自己多试试不就知道了
如果改成0,0就是表示从左上角开始切割裁剪[/quote]
这个已经解决太感谢你了，还有一个问题，就是保存下来的图处质量不是很好感觉品质被压缩过，这个有没有办法调整啊
一把编程的菜刀 2013-08-02
- 打赏
- 举报
修改了半天，没有成功，请大师能否再明白一点[/quote]
已经解释的很明白了吧
jpeg.crop x1,y1,x2,y2
里面的前面x1,y1 这个2个参数改成0,0他就会是保留上面部分了，当然主要是y1这个参数是控制上下的，x1主要是控制左右的
你只要针对x1,y1进行调整，也就是这个2个参数值控制从哪里开始切割裁剪，自己多试试不就知道了
如果改成0,0就是表示从左上角开始切割裁剪
bowbogcy 2013-08-01
- 打赏
- 举报
求修改-比如竖板的人物图片裁剪成方形成把头和脚都载了，能否修改成载掉图片下面部分保留上部分
这个很简单的，你只要把下面这个
jpeg.crop x1,y1,x2,y2
里面的前面x1,y1 这个2个参数改成0,0他就会是保留上面部分了，当然主要是y1这个参数是控制上下的，x1主要是控制左右的[/quote]
修改了半天，没有成功，请大师能否再明白一点
一把编程的菜刀 2013-08-01
- 打赏
- 举报
求修改-比如竖板的人物图片裁剪成方形成把头和脚都载了，能否修改成载掉图片下面部分保留上部分
这个很简单的，你只要把下面这个
jpeg.crop x1,y1,x2,y2
里面的前面x1,y1 这个2个参数改成0,0他就会是保留上面部分了，当然主要是y1这个参数是控制上下的，x1主要是控制左右的
csdn_aspnet 2013-08-01
- 打赏
- 举报
aspjpeg 图片等比例缩放加水印源码
<%
sub aspjpeg(LocalFile,TargetFile,maxw,maxh)
Dim Jpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
If Err.Number=-2147221005 then
Response.write "没有这个组件，请安装!"'检查是否安装AspJpeg组件
Response.End()
End If
Jpeg.Open (Server.MapPath(LocalFile))'打开图片
If err.number then
Response.write"打开图片失败,请检查路径！"
Response.End()
End if
dim imgw,imgh,bili
imgw=Jpeg.OriginalWidth
imgh=Jpeg.OriginalHeight
bili=Jpeg.OriginalWidth/Jpeg.OriginalHeight
if imgw>imgh then
if imgw>maxw then
imgw=maxw
imgh=imgw / bili
end if
elseif imgw<imgh then
if imgh>maxh then
imgh=maxh
imgw=imgh * bili
end if
else
if imgw>maxw then
imgw=maxw
imgh=imgw / bili
end if
end if
Jpeg.Width = imgw
Jpeg.Height = imgh
Dim TempA '原始图片的二进制数据
Dim TempB '加了不透明文字水印的图片
Dim TempC '最终效果
TempA=Jpeg.Binary'将原始数据赋给TempA
'=========加文字水印=================
Jpeg.Canvas.Font.Color = &Hfffffff'水印文字颜色
Jpeg.Canvas.Font.Family = Arial'字体
Jpeg.Canvas.Font.Bold = True'是否加粗
Jpeg.Canvas.Font.Size = 35'字体大小
Jpeg.Canvas.Font.ShadowColor = &H000000'阴影色彩
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = True
Jpeg.Canvas.Font.Quality = 5'输出质量
Jpeg.Canvas.PrintText imgw/2-180,imgh/2,"家装情报网（jzqbw.com）"'水印位置及文字
TempB=Jpeg.Binary'将文字水印处理后的值赋给TempB，这时，文字水印没有不透明度
'============调整文字透明度================
Set MyJpeg = Server.CreateObject("Persits.Jpeg")
MyJpeg.OpenBinary TempA
Set Logo = Server.CreateObject("Persits.Jpeg")
Logo.OpenBinary TempB
MyJpeg.DrawImage 0,0, Logo, 0.2'0.3是透明度
TempC=MyJpeg.Binary'将最终结果赋值给TempC,这时也可以生成目标图片了
'response.BinaryWrite TempC'将二进输出给浏览器
' response.BinaryWrite TempC'将二进输出给浏览器
' MyJpeg.Interpolation=0 '不改变图片质量
' MyJpeg.Quality=100 '不改变图片质量
MyJpeg.Save (Server.MapPath(TargetFile))
set TempA=nothing
set TempB=nothing
set TempC=nothing
Logo.Close
MyJpeg.Close
Jpeg.close
end sub
%>
ASP源码之AspJpeg组件/加水印/缩略图/合成图/裁剪图
<%
'用AspJpeg组件生成图片缩略图
'Call AsaiPicSuo(被处理图片,处理后图片,缩略图宽,缩略图高)
Sub AsaiPicSuo(pic1,pic2,pwid,phei)
dim Fpicsuo
Set Fpicsuo = Server.CreateObject("Persits.Jpeg") '创建实例
Fpicsuo.Open Server.MapPath(pic1) '打开图片
if pwid=0 or phei=0 then
'调整宽度和高度为原来的50%
Fpicsuo.Width = Fpicsuo.OriginalWidth / 2
Fpicsuo.Height = Fpicsuo.OriginalHeight / 2
else
Fpicsuo.Width = pwid
Fpicsuo.Height = phei
end if
Fpicsuo.Save Server.MapPath(pic2) '保存图片到磁盘
Fpicsuo.Close:Set Fpicsuo = Nothing
End Sub
'用AspJpeg组件生成图片水印
'Call AsaiPicShui(被处理图片,处理后图片,加水印的文字)
Sub AsaiPicShui(pic1,pic2,str)
dim Fpicshui
Set Fpicshui = Server.CreateObject("Persits.Jpeg")
Fpicshui.Open Server.MapPath(pic1)
if str<>"" then'开始写文字
Fpicshui.Canvas.Font.Color = &HFF0000 ' red颜色
Fpicshui.Canvas.Font.Family = "Arial" '字体
Fpicshui.Canvas.Font.Bold = True '是否加粗
Fpicshui.Canvas.Print 10, 10, str
'打印坐标x 打印坐标y 需要打印的字符
'以下是对图片进行边框处理
'Fpicshui.Canvas.Pen.Color = &HD8D8D8' black 颜色
'Fpicshui.Canvas.Pen.Width = 2 '画笔宽度
'Fpicshui.Canvas.Brush.Solid = False '//边框内是否填充颜色，你可以试试看值为True时的效果^o^
'Fpicshui.Canvas.Bar 1, 1, Fpicshui.Width, Fpicshui.Height '起始X坐标 起始Y坐标 输入长度 输入高度
end if
Fpicshui.Save Server.MapPath(pic2) '保存
Fpicshui.Close:Set Fpicshui = Nothing
End Sub
'用AspJpeg组件生成图片水印，直接加图片
'Call AsaiPicYin(水印图片,需加水印的图片,加水印后的图片,水印宽度,水印高度)
Sub AsaiPicYin(pic1,pic2,pic3,pwid,phei)
dim Fpicyin1,Fpicyin2
Set Fpicyin1 = Server.CreateObject("Persits.Jpeg")
Fpicyin1.Open Server.MapPath(pic1)
Fpicyin1.Interpolation=1
Fpicyin1.Quality=100
Fpicyin1.Width = pwid
Fpicyin1.Height = phei
Set Fpicyin2 = Server.CreateObject("Persits.Jpeg")
Fpicyin2.Open Trim(Server.MapPath(pic2))
Fpicyin2.Canvas.Pen.Color = &H000000 '//增加水印后图片的边框色彩。
Fpicyin2.Canvas.Pen.Width = 1 '//增加水印后图片的边框宽度。
Fpicyin2.Canvas.Brush.Solid = False '//边框内是否填充颜色，你可以试试看值为True时的效果^o^
Fpicyin2.DrawImage Fpicyin2.width-pwid, Fpicyin2.height-phei, Fpicyin1, 0.6
Fpicyin2.Canvas.Bar 0, 0, Fpicyin2.Width, Fpicyin2.Height
Fpicyin2.Save Server.MapPath(pic3)
Fpicyin1.Close:Set Fpicyin1=Nothing
Fpicyin2.Close:Set Fpicyin2=Nothing
End Sub
'用AspJpeg组件进行图片合并，必需创建两个AspJpeg实例对象
'Call AsaiPicJia(组合第一张图片,组合第二张图片,组合后的图片)
Sub AsaiPicJia(pic1,pic2,pic3)
Dim Fpicjia1,Fpicjia2
Set Fpicjia1 = Server.CreateObject("Persits.Jpeg")
Set Fpicjia2 = Server.CreateObject("Persits.Jpeg")
Fpicjia1.Open Server.MapPath(pic1)
Fpicjia2.Open Server.MapPath(pic2)
Fpicjia1.Canvas.DrawImage 10, 10, Fpicjia2
Fpicjia1.save Server.mappath(pic3)
Fpicjia1.Close:Set Fpicjia1 = Nothing
Fpicjia2.Close:Set Fpicjia2 = Nothing
End Sub
'用AspJpeg组件进行图片切割
'Call AsaiPicJian(被处理图片,处理后图片,减掉宽,减掉高)
Sub AsaiPicJian(pic1,pic2,pwid,phei)
Dim Fpicjian
Set Fpicjian = Server.CreateObject("Persits.Jpeg")
Fpicjian.Open Server.MapPath(pic1)
Fpicjian.Crop 20, 30, Fpicjian.Width - pwid, Fpicjian.Height - phei
Fpicjian.save Server.mappath(pic2)
Fpicjian.Close:Set Fpicjian = Nothing
End Sub
%>
