·进入以前版本帮助
·官方站
·技术论坛
·演示中心
·域名主机
·智能建站系统
·商业版本购买
·关于我们

四川成都武侯区惠民街109号A座8层1-34、36
邮编:610041
电话总机:028-85098980; 028-66026180; 028-82105266
产品咨询:602, 代理合作:601
技术支持:607, 项目开发606
网站建设:609, 客服:608
市场支持:605,028-82105266
网站建设:028-85098980/605,028-82105266, 传真603
电子邮件:service@foosun.cn, office@foosun.cn, MSN:foosun0@hotmail.com
 
专题导航:新手入门系统操作模板制作标签使用高级使用采集系统
搜索
位置:首页>>使用技巧>>正文
采集存图自动添加水印1
属性:2005-10-28 上午 11:19:08||

采集添加水印方法:
打开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

本新闻共3页,当前在第1页  1  2  3  

 


Copyright 2002-2005 Foosun,Inc.           Powered by FoosunCMS3.1.0930