|
采集添加水印方法: 打开foosun/admin/collect/inc/function.asp文件, 1、查找函数:Function ReplaceIMGRemoteUrl(中的Call SaveRemoteFile(DummyPath & SaveFilePath & "/" & SaveIMGFileName,RemoteFileurl) 然后在其下增加一行: AddWaterMark DummyPath & SaveFilePath & "/" & SaveIMGFileName '在保存好的图片上添加水印
2、在此文件的最后%>复制如下内容: '''''''''''''''''''''''''''''' '为文件添加水印 Function AddWaterMark(FileName) Dim strMarkSettingSql,MarkSettingRs,objFileSystem,strFileExtName,objImage If InStr(FileName,":") = 0 Then '把文件名转换为实际路径 FileName = Server.Mappath(FileName) End if If FileName <> "" and not IsNull(FileName) Then '文件名是否不为空,否则退出 strFileExtName = "" If InStr(FileName,".") <> 0 Then strFileExtName = Lcase(Trim(Mid(FileName,InStrRev(FileName,".")+1))) End if If strFileExtName <> "jpg" and strFileExtName <> "gif" and strFileExtName <> "bmp" and strFileExtName <> "png" Then'文件不是可用图片则退出 Exit Function End if Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject") If objFileSystem.FileExists(FileName) Then '文件存在,否则退出 strMarkSettingSql = "select * from FS_config" Set MarkSettingRs = conn.Execute(strMarkSettingSql) If MarkSettingRs("MarkComponent") <> "0" Then '选择了某个水印组件,否则退出 Select Case MarkSettingRs("MarkComponent") Case "1" '使用AspJpeg组件 If IsObjInstalled("Persits.Jpeg") Then 'AspJpeg组件已安装,否则退出 If IsExpired("Persits.Jpeg") Then Response.Write("Persits.Jpeg组件已过期,请选择其他组件或关闭水印功能。") Response.End End if If MarkSettingRs("MarkType") = "1" Then '添加文字水印 AddTextMark 1,MarkSettingRs("MarkText"),MarkSettingRs("MarkFontColor"),MarkSettingRs("MarkFontName"),MarkSettingRs("MarkFontBond"),MarkSettingRs("MarkFontSize"),MarkSettingRs("MarkPosition"),FileName Else '添加图片水印 AddPictureMark 1,MarkSettingRs("MarkWidth"),MarkSettingRs("MarkHeight"),MarkSettingRs("MarkPicture"),MarkSettingRs("MarkOpacity"),MarkSettingRs("MarkTranspColor"),MarkSettingRs("MarkPosition"),FileName End if End if Case "2" '使用wsImage组件 If strFileExtName = "png" Then 'wsImage组件不支持PNG文件,是则退出 Exit Function End if If IsObjInstalled("wsImage.Resize") Then 'wsImage组件已安装,否则退出 If IsExpired("wsImage.Resize") Then Response.Write("wsImage.Resize组件已过期,请选择其他组件或关闭水印功能。") Response.End End if If MarkSettingRs("MarkType") = "1" Then '添加文字水印 AddTextMark 2,MarkSettingRs("MarkText"),MarkSettingRs("MarkFontColor"),MarkSettingRs("MarkFontName"),MarkSettingRs("MarkFontBond"),MarkSettingRs("MarkFontSize"),MarkSettingRs("MarkPosition"),FileName Else '添加图片水印 AddPictureMark 2,MarkSettingRs("MarkWidth"),MarkSettingRs("MarkHeight"),MarkSettingRs("MarkPicture"),MarkSettingRs("MarkOpacity"),MarkSettingRs("MarkTranspColor"),MarkSettingRs("MarkPosition"),FileName End if End if Case "3" '使用SA-ImgWriter组件 If IsObjInstalled("SoftArtisans.ImageGen") Then 'SA-ImgWriter组件已安装,否则退出 If IsExpired("SoftArtisans.ImageGen") Then Response.Write("SoftArtisans.ImageGen组件已过期,请选择其他组件或关闭水印功能。") Response.End End if If MarkSettingRs("MarkType") = "1" Then '添加文字水印 AddTextMark 3,MarkSettingRs("MarkText"),MarkSettingRs("MarkFontColor"),MarkSettingRs("MarkFontName"),MarkSettingRs("MarkFontBond"),MarkSettingRs("MarkFontSize"),MarkSettingRs("MarkPosition"),FileName Else '添加图片水印 AddPictureMark 3,MarkSettingRs("MarkWidth"),MarkSettingRs("MarkHeight"),MarkSettingRs("MarkPicture"),MarkSettingRs("MarkOpacity"),MarkSettingRs("MarkTranspColor"),MarkSettingRs("MarkPosition"),FileName End if End if End Select End if Set MarkSettingRs = nothing End if Set objFileSystem = nothing End if End Function '为图片添加文字水印 Function AddTextMark(MarkComponentID,MarkText,MarkFontColor,MarkFontName,MarkFontBond, MarkFontSize,MarkPosition,FileName) Dim objImage,X,Y,Text,TextWidth,FontColor,FontName,FondBond,FontSize,OriginalWidth,OriginalHeight If InStr(FileName,":") = 0 Then '把文件名转换为实际路径 FileName = Server.Mappath(FileName) End if Text = Trim(MarkText) If Text = "" Then Exit Function End if FontColor = Replace(MarkFontColor,"#","&H") FontName = MarkFontName If MarkFontBond = "1" Then FondBond = True Else FondBond = False End if FontSize = Cint(MarkFontSize) Select Case MarkComponentID Case 1 If Not IsObjInstalled("Persits.Jpeg") Then Exit Function End if Set objImage = Server.CreateObject("Persits.Jpeg") objImage.Open FileName objImage.Canvas.Font.Color = FontColor objImage.Canvas.Font.Family = FontName objImage.Canvas.Font.Bold = FondBond objImage.Canvas.Font.Size = FontSize TextWidth = objImage.Canvas.GetTextExtent(Text) '计算GB2313编码的字符串所占宽度 If objImage.OriginalWidth < TextWidth Or objImage.OriginalHeight < FontSize Then '如果图片高度小于字体大小或宽度小于字符串宽度则退出 Exit Function End if GetPostion Cint(MarkPosition),X,Y,objImage.OriginalWidth,objImage.OriginalHeight,TextWidth,FontSize '计算坐标 objImage.Canvas.Print X, Y, Text,134 objImage.Save FileName Case 2 If Not IsObjInstalled("wsImage.Resize") Then Exit Function End if Set objImage = Server.CreateObject("wsImage.Resize") objImage.LoadSoucePic Cstr(FileName) objImage.TxtMarkFont = CStr(FontName) objImage.TxtMarkBond = FondBond objImage.TxtMarkHeight = FontSize 'objImage.GetSourceInfo OriginalWidth,OriginalHeight 'GetPostion Cint(MarkPosition),X,Y,OriginalWidth,OriginalHeight,Len(Text)*FontSize*3/4,FontSize '计算坐标 FontColor = "&H"&Mid(FontColor,7)&Mid(FontColor,5,2)&Mid(FontColor,3,2) '颜色代码转换&HBBGGRR objImage.AddTxtMark Cstr(FileName),CStr(Text),Clng(FontColor),1,1 Case 3 If Not IsObjInstalled("SoftArtisans.ImageGen") Then Exit Function End if Set objImage = Server.CreateObject("SoftArtisans.ImageGen") objImage.LoadImage FileName objImage.Font.height = FontSize objImage.Font.name = FontName FontColor = "&H"&Mid(FontColor,7)&Mid(FontColor,5,2)&Mid(FontColor,3,2) '颜色代码转换&HBBGGRR objImage.Font.Color = Clng(FontColor) objImage.Text = Text GetPostion Cint(MarkSettingRs("MarkPosition")),X,Y,objImage.Width,objImage.Height,objImage.TextWidth,objImage.TextHeight '计算坐标 objImage.DrawTextOnImage X, Y,objImage.TextWidth,objImage.TextHeight |