ASP wsImage组件的插入方法及使用方法
发布时间：2023-06-28 14:49:08 所属栏目：Asp教程 来源：
导读：ASP给图片加水印是需要组件的...常用的有aspjpeg软件和中国人自己开发的wsImage软件，可以上网搜索下载这两个软件，推荐使用咱们中国人自己开发的wsImage，毕竟是中文版，容易操作．
注册组件的方法:
命令提
注册组件的方法:
命令提
|
ASP给图片加水印是需要组件的...常用的有aspjpeg软件和中国人自己开发的wsImage软件，可以上网搜索下载这两个软件，推荐使用咱们中国人自己开发的wsImage，毕竟是中文版，容易操作． 注册组件的方法: 命令提示符下输入"regsvr32 [Dll路径]" 就可以了． 图片添加水印无非就是获得图片大小,然后把水印写上去..ASP代码只是起个控制组件的作用.用代码来说明一切吧. 一:获得图片大小(这里是用象素值表示的.学PhotoShop的朋友都应该明白) 复制代码代码如下: <% set obj=server.CreateObject("wsImage.Resize") ''调用组件 obj.LoadSoucePic server.mappath("25.jpg") ''打开图片,图片名字是25.jpg obj.GetSourceInfo iWidth,iHeight response.write "图片宽度:" & iWidth & "<br>" ''获得图片宽度 response.write "图片高度:" & iHeight & "<br>" ''获得图片高度 strError=obj.errorinfo if strError<>"" then response.write obj.errorinfo end if obj.free set obj=nothing %> ''----------------------------------------------------------------'' 二:添加文字水印 复制代码代码如下: <% set obj=server.CreateObject("wsImage.Resize") obj.LoadSoucePic server.mappath("25.jpg") ''装载图片 obj.Quality=75 obj.TxtMarkFont = "华文彩云" ''设置水印文字字体 obj.TxtMarkBond = false ''设置水印文字的粗细 obj.MarkRotate = 0 ''水印文字的旋转角度 obj.TxtMarkHeight = 25 ''水印文字的高度 obj.AddTxtMark server.mappath("txtMark.jpg"), "带你离境", &H00FF00&, 10, 70 strError=obj.errorinfo ''生成图片名字,文字颜色即水印在图片的位置 if strError<>"" then response.write obj.errorinfo end if obj.free set obj=nothing %> ''----------------------------------------------------------------'' 三:添加图片水印 复制代码代码如下: <% set obj=server.CreateObject("wsImage.Resize") obj.LoadSoucePic server.mappath("25.jpg") ''装载图片 obj.LoadImgMarkPic server.mappath("blend.bmp") ''装载水印图片 obj.Quality=75 obj.AddImgMark server.mappath("imgMark.jpg"), 315, 220,&hFFFFFF, 70 strError=obj.errorinfo ''生成图片名字,文字颜色即水印在图片的位置 if strError<>"" then response.write obj.errorinfo end if obj.free set obj=nothing %> ''----------------------------------------------------------------'' 其实给图片添加水印就这么简单.然后我在说下WsImage.dll组件的另外两个主要用法.包括: 剪裁图片,生成图片的缩略图. 还是以我得习惯,用代码加注释说明: 剪裁图片: 复制代码代码如下: <% set obj=server.CreateObject("wsImage.Resize") obj.LoadSoucePic server.mappath("25.jpg") obj.Quality=75 obj.cropImage server.mappath("25_crop.jpg"),100,10,200,200 ''定义裁减大小和生成图片名字 strError=obj.errorinfo if strError<>"" then response.write obj.errorinfo end if obj.free set obj=nothing %> 详细注释:裁减图片用到了WsImage的CropImage方法.其中定义生成图片时候,100,10是左上角的裁减点,即离图片左边是100象素,顶端10象素.后两个200代表的是裁减的宽带和高和高度. ''----------------------------------------------------------------'' 生成图片缩略图: 复制代码代码如下: <% set obj=server.CreateObject("wsImage.Resize") obj.LoadSoucePic server.mappath("25.jpg") ''加载图片 obj.Quality=75 obj.OutputSpic server.mappath("25_s.jpg"),0.5,0.5,3 ''定义缩略图的名字即大小 strError=obj.errorinfo if strError<>"" then response.write obj.errorinfo end if obj.free set obj=nothing %> 详细说明: 产生缩略图共有四种导出方式： (1) obj.OutputSpic server.mappath("25_s.jpg"),200,150,0 200为输出宽，150为输出高，这种输出形式为强制输出宽高，可能引起图片变形。 (2) obj.OutputSpic server.mappath("25_s.jpg"),200,0,1 以200为输出宽，输出高将随比列缩放。 (3) obj.OutputSpic server.mappath("25_s.jpg"),0,200,2 以200为输出高，输出宽将随比列缩放。 (4) obj.OutputSpic server.mappath("25_s.jpg"),0.5,0.5,3 第一个0.5表示生成的缩略图是原图宽的一半，即表示宽缩小比例。 第二个0.5表示生成的缩略图是原图高的一半，即表示高缩小比例。 宽高的缩小比例一致意味着将对原图进行比例缩小。宽高的缩放比例如果大于1，则对原图进行放大。 2--------------------------------------------------------------------------------------- 复制代码代码如下: <% Dim stream1,stream2,istart,iend,filename istart=1 vbEnter=Chr(13)&Chr(10) function getvalue(fstr,foro,paths)'fstr为接收的名称，foro布尔false为文件上传,true 为普通字段，path为上传文件存放路径 if foro then getvalue="" istart=instring(istart,fstr) istart=istart+len(fstr)+5 iend=instring(istart,vbenter+"-----------------------------") if istart>5+len(fstr) then getvalue=substring(istart,iend-istart) else getvalue="" end if else istart=instring(istart,fstr) istart=istart+len(fstr)+13 iend=instring(istart,vbenter)-1 filename=substring(istart,iend-istart) filename9=right(getfilename(filename),4)'取原文件后缀 filename8=year(now())&month(now())&day(now())&hour(now())&minute(now())&second(now())&int(9*10^3*rnd)+10^3'取随机文件名, '如果你要加长文件名,请修改(100*rnd)中100的值 filename=replace(getfilename(filename),getfilename(filename),filename8) '替换原文件名,活用replace函数 filename=filename&filename9 '加上文件后缀,规则为生成的随机文件名加上原文件后缀 istart=instring(iend,vbenter+vbenter)+3 iend=instring(istart,vbenter+"-----------------------------") filestart=istart filesize=iend-istart-1 objstream.position=filestart Set sf = Server.CreateObject("ADODB.Stream") sf.Mode=3 sf.Type=1 sf.Open objstream.copyto sf,FileSize if filename<>"" then Set rf = Server.CreateObject("Scripting.FileSystemObject") i=0 fn=filename while rf.FileExists(server.mappath(paths+fn)) fn=cstr(i)+filename i=i+1 wend filename=fn sf.SaveToFile server.mappath(paths+filename),2 ''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Jpeg Set Jpeg = Server.CreateObject("Persits.Jpeg") If -2147221005=Err then Response.write "没有这个组件，请安装!" '检查是否安装AspJpeg组件 Response.End() End If Jpeg.Open (server.mappath(paths+filename)) '打开图片 If err.number then Response.write"打开图片失败,请检查路径！" Response.End() End if Dim aa aa=Jpeg.Binary '将原始数据赋给aa '=========加文字水印================= Jpeg.Canvas.Font.Color = &Hff0000 '水印文字颜色 Jpeg.Canvas.Font.Family = Arial'字体 Jpeg.Canvas.Font.Bold = True '是否加粗 Jpeg.Canvas.Font.Size = 30'字体大小 Jpeg.Canvas.Font.ShadowColor = &H000000 '阴影色彩 Jpeg.Canvas.Font.ShadowYOffset = 1 Jpeg.Canvas.Font.ShadowXOffset = 1 Jpeg.Canvas.Brush.Solid = True Jpeg.Canvas.Font.Quality = 4 '输出质量 Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-100,Jpeg.OriginalHeight/2+20,"www.my9933.com" '水印位置及文字 bb=Jpeg.Binary '将文字水印处理后的值赋给bb，这时，文字水印没有不透明度 '============调整文字透明度================ Set MyJpeg = Server.CreateObject("Persits.Jpeg") MyJpeg.OpenBinary aa Set Logo = Server.CreateObject("Persits.Jpeg") Logo.OpenBinary bb MyJpeg.DrawImage 0,0, Logo, 0.2 '0.3是透明度 cc=MyJpeg.Binary '将最终结果赋值给cc,这时也可以生成目标图片了 response.BinaryWrite cc '将二进输出给浏览器 MyJpeg.Save (server.mappath(paths+filename)) set aa=nothing set bb=nothing set cc=nothing Jpeg.close MyJpeg.Close Logo.Close ''''''''''''''''''''''''''''''''''''''''''''''''''''' end if getvalue=filename end if end function Function subString(theStart,theLen) dim i,c,stemp objStream.Position=theStart-1 stemp="" for i=1 to theLen if objStream.EOS then Exit for c=ascB(objStream.Read(1)) If c > 127 Then if objStream.EOS then Exit for stemp=stemp&Chr(AscW(ChrB(AscB(objStream.Read(1)))&ChrB(c))) i=i+1 else stemp=stemp&Chr(c) End If Next subString=stemp End function Function inString(theStart,varStr) dim i,j,bt,theLen,str InString=0 Str=toByte(varStr) theLen=LenB(Str) for i=theStart to objStream.Size-theLen if i>objstream.size then exit Function objstream.Position=i-1 if AscB(objstream.Read(1))=AscB(midB(Str,1)) then InString=i for j=2 to theLen if objstream.EOS then inString=0 Exit for end if if AscB(objstream.Read(1))<>AscB(MidB(Str,j,1)) then InString=0 Exit For end if next if InString<>0 then Exit Function end if next End Function Private function GetFileName(FullPath) If FullPath <> "" Then GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1) Else GetFileName = "" End If End function function toByte(Str) dim i,iCode,c,iLow,iHigh toByte="" For i=1 To Len(Str) c=mid(Str,i,1) iCode =Asc(c) If iCode<0 Then iCode = iCode + 65535 If iCode>255 Then iLow = Left(Hex(Asc(c)),2) iHigh =Right(Hex(Asc(c)),2) toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh) Else toByte = toByte & chrB(AscB(c)) End If Next End function %> 3--------------------------------------------------------------------------------------- 用asp组件Persits.Jpeg给图片加水印，生成缩略图 复制代码代码如下: <% FileName="1.jpg" Set Jpeg = Server.CreateObject("Persits.Jpeg") ' 获取源图片路径 Path = Server.MapPath(FileName) ' 打开源图片 'response.write(Path) Jpeg.Open Path ' 设定生成缩略图细节 这里有很多种设定方法 下面的方法是先判断宽高比 然后按比例缩放 If Jpeg.OriginalWidth / Jpeg.OriginalHeight > 1 then Jpeg.Width = 98 Jpeg.Height = int((98/Jpeg.OriginalWidth)*Jpeg.OriginalHeight) elseif Jpeg.OriginalWidth / Jpeg.OriginalHeight < 1 then Jpeg.Width = 98 Jpeg.Height= int((98/Jpeg.OriginalWidth)*Jpeg.Height) end if ' 设定锐化效果 Jpeg.Sharpen 1, 130 ' 向指定路径生成缩略图 Response.Write Server.MapPath(".") Jpeg.Save Server.MapPath(".")&"/small/"&filename 'response.write filename1 'response.write Server.MapPath("uploadpic/small")&"/"&filename1 ' 注意这两个Session 'Session("PPP0")=GP_curPath&FileName 'Session("PPP1")=GP_curPath&"small"&FileName Set Jpeg = Nothing '自动产生缩掠图结束 '大图片打水印开始 ' 建立实例 Set Jpeg = Server.CreateObject("Persits.Jpeg") ' 打开目标图片 Path = Server.MapPath(FileName) ' 打开源图片 Jpeg.Open Path ' 添加文字水印 Jpeg.Canvas.Font.Color = &HFF0000' 红色 Jpeg.Canvas.Font.Family = "宋体" Jpeg.Canvas.Font.Bold = True Jpeg.Canvas.Print 10, 10, "宏蓝科技" ' 保存文件 Jpeg.Save Server.MapPath(".")&"/small/w_"&filename ' 注销对象 Set Jpeg = Nothing '大图片打水印结束 %> 4--------------------------------------------------------------------------------------- 利用ASPJPEG组建加水印ASP实现代码 复制代码代码如下: <% Class qswhImg dim aso Private Sub Class_Initialize set aso=CreateObject("Adodb.Stream") aso.Mode=3 aso.Type=1 aso.Open End Sub Private Sub Class_Terminate set aso=nothing End Sub Private Function Bin2Str(Bin) Dim I, Str For I=1 to LenB(Bin) clow=MidB(Bin,I,1) if ASCB(clow)<128 then Str = Str & Chr(ASCB(clow)) else I=I+1 if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow)) end if Next Bin2Str = Str End Function Private Function Num2Str(num,base,lens) 'qiushuiwuhen (2002-8-12) dim ret ret = "" while(num>=base) ret = (num mod base) & ret num = (num - num mod base)/base wend Num2Str = right(string(lens,"0") & num & ret,lens) End Function Private Function Str2Num(str,base) 'qiushuiwuhen (2002-8-12) dim ret ret = 0 for i=1 to len(str) ret = ret *base + cint(mid(str,i,1)) next Str2Num=ret End Function Private Function BinVal(bin) 'qiushuiwuhen (2002-8-12) dim ret ret = 0 for i = lenb(bin) to 1 step -1 ret = ret *256 + ascb(midb(bin,i,1)) next BinVal=ret End Function Private Function BinVal2(bin) 'qiushuiwuhen (2002-8-12) dim ret ret = 0 for i = 1 to lenb(bin) ret = ret *256 + ascb(midb(bin,i,1)) next BinVal2=ret End Function Function getImageSize(filespec) 'qiushuiwuhen (2002-9-3) dim ret(3) aso.LoadFromFile(filespec) bFlag=aso.read(3) select case hex(binVal(bFlag)) case "4E5089": aso.read(15) ret(0)="PNG" ret(1)=BinVal2(aso.read(2)) aso.read(2) ret(2)=BinVal2(aso.read(2)) case "464947": aso.read(3) ret(0)="GIF" ret(1)=BinVal(aso.read(2)) ret(2)=BinVal(aso.read(2)) case "535746": aso.read(5) binData=aso.Read(1) sConv=Num2Str(ascb(binData),2 ,8) nBits=Str2Num(left(sConv,5),2) sConv=mid(sConv,6) while(len(sConv)<nBits*4) binData=aso.Read(1) sConv=sConv&Num2Str(ascb(binData),2 ,8) wend ret(0)="SWF" ret(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20) ret(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20) case "FFD8FF": do do: p1=binVal(aso.Read(1)): loop while p1=255 and not aso.EOS if p1>191 and p1<196 then exit do else aso.read(binval2(aso.Read(2))-2) do:p1=binVal(aso.Read(1)):loop while p1<255 and not aso.EOS loop while true aso.Read(3) ret(0)="JPG" ret(2)=binval2(aso.Read(2)) ret(1)=binval2(aso.Read(2)) case else: if left(Bin2Str(bFlag),2)="BM" then aso.Read(15) ret(0)="BMP" ret(1)=binval(aso.Read(4)) ret(2)=binval(aso.Read(4)) else ret(0)="" end if end select ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &"""" getimagesize=ret End Function End Class SavefullPath="326151745wldn.jpg" '图片路径赋值 或 图片路径变量赋值 '取得图片的宽度 Set qswh = new qswhImg arr = qswh.getImageSize(Server.Mappath(SavefullPath)) Set qswh = Nothing str_ImgWidth=arr(1) str_ImgHeight=arr(2) If Int(str_ImgWidth) > 600 Then str_ImgWidth = 600 Else str_ImgWidth = str_ImgWidth End If '加水印 If Int(str_ImgWidth) > 300 And Int(str_ImgHeight) > 100 Then LocalFile=Server.MapPath(SavefullPath) TargetFile=Server.MapPath(SavefullPath) Dim Jpeg Set Jpeg = Server.CreateObject("Persits.Jpeg") If -2147221005=Err then Response.Write("<script language='javascript'>alert('没有这个组件，请安装!');history.back();</script>") '检查是否安装AspJpeg组件 Response.End() End If Jpeg.Open (LocalFile) '打开图片 If err.number then Response.Write("<script language='javascript'>alert('打开图片失败,请检查路径！');history.back();</script>") Response.End() End if Dim aa aa=Jpeg.Binary '将原始数据赋给aa '=========加文字水印================= Jpeg.Canvas.Font.Color = &Hfffffff '水印文字颜色 Jpeg.Canvas.Font.Family = Arial '字体 Jpeg.Canvas.Font.Bold = True '是否加粗 Jpeg.Canvas.Font.Size = 20 '字体大小 Jpeg.Canvas.Font.ShadowColor = &H000000 '阴影色彩 Jpeg.Canvas.Font.ShadowYOffset = 1 Jpeg.Canvas.Font.ShadowXOffset = 1 Jpeg.Canvas.Brush.Solid = True Jpeg.Canvas.Font.Quality = 10 ' '输出质量 Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-40,Jpeg.OriginalHeight/2-10,"网站建设" '水印位置及文字 bb=Jpeg.Binary '将文字水印处理后的值赋给bb，这时，文字水印没有不透明度 '============调整文字透明度================ Set MyJpeg = Server.CreateObject("Persits.Jpeg") MyJpeg.OpenBinary aa Set Logo = Server.CreateObject("Persits.Jpeg") Logo.OpenBinary bb MyJpeg.DrawImage 0,0, Logo, 0.5 '0.3是透明度 cc=MyJpeg.Binary '将最终结果赋值给cc,这时也可以生成目标图片了 Response.BinaryWrite cc '将二进输出给浏览器 MyJpeg.Save (TargetFile) set aa = nothing set bb = nothing set cc = nothing Jpeg.Close MyJpeg.Close Logo.Close End If '加水印 %> （编辑：聊城站长网） 【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容! |
推荐文章
站长推荐
