查看完整版本: 可控制的给图片加水印的方法

可控制的给图片加水印的方法

核心代码使用的是debugger的作品(http://bbs.rainbowsoft.org/viewthread.php?tid=11792)，我只是在他的基础上加上了一个判断，使得上传图片的时候可以指定该图片是否需要加上水印。因为原来上传附件有一个“自动命名上传附件功能”，我把代码设定成了如果使用自动命名功能，就给图片加上水印，否则就不加水印。
如果需要在非自动命名的时候加水印的花，只要把[code]If bolAutoName=True Then [/code]修改成[code]If bolAutoName=FalseThen [/code] 就可以了。

使用的时候，把下面的代码粘贴到function\c_system_lib.asp文件里面的Upload函数的最后面。注意把“www.WinsHome.com”修改成自己想要加上的水印文字。

[code]
                '图片加上水印
                If CheckRegExp(LCase(FileName),"jpg|gif|bmp|png") Then
                        '如果使用自动命名模式就加上水印
                        If bolAutoName=True Then
                                Dim Jpeg
                                Set Jpeg = Server.CreateObject("Persits.Jpeg")
                                Jpeg.Open BlogPath & "/" & ZC_UPLOAD_DIRECTORY  &  "/"  & FileName  ' 图片所在位置
                               
                                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 = 24 '字体大小
                                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 5,5,"www.WinsHome.com" '水印位置及文字
                                bb=Jpeg.Binary '将文字水印处理后的值赋给bb，这时，文字水印没有不透明度
                               
                                '============调整文字透明度================
                                dim MyJpeg
                                Dim Logo
                                dim 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是透明度
                                MyJpeg.Save BlogPath & "/" & ZC_UPLOAD_DIRECTORY & "/" & FileName  ' 保存文件
                                set aa=nothing
                                set bb=nothing
                                Jpeg.close
                                MyJpeg.Close
                                Logo.Close
                        END IF
                END IF
[/code]

[[i] 本帖最后由 久远 于 2007-5-29 21:10 编辑 [/i]]

搞了半天,一点效果都没有!不知道是不是我笨用不了!代码加进去,但是出来的图片还是没有水印

[quote]原帖由 [i]birdmj[/i] 于 2007-6-7 10:21 发表
搞了半天,一点效果都没有!不知道是不是我笨用不了!代码加进去,但是出来的图片还是没有水印 [/quote]

首先需要服务器支持ASPJPG组件，然后在上传附件的时候选择“自动命名”才会添加水印。

测试成功，感谢lz，我是把代码放在西面这段代码的后面：[code]Public Function UpLoad(bolAutoName)
  If UploadType="Form" Then
   Call UpLoad_Form()
  ElseIf UploadType="Stream" Then
   Call UpLoad_Stream()
  End If
  If InStrRev(FileName,"\")>0 Then
   FileName=Mid(FileName,InStrRev(FileName,"\")+1)
  End If
  If InStrRev(FileName,"/")>0 Then
   FileName=Mid(FileName,InStrRev(FileName,"\")+1)
  End If
  FileName=TransferHTML(FileName,"[filename]")
  '超出类型限制
  If Not CheckRegExp(LCase(FileName),"\.("& ZC_UPLOAD_FILETYPE &")$") Then Call ShowError(26)
  '超出大小限制
  If FileSize>ZC_UPLOAD_FILESIZE Then Call ShowError(27)
  FileName=FilterSQL(FileName)
  If bolAutoName=True Then
   Randomize
   FileName=Year(Now) & Right("0"&Month(Now),2) & Right("0"&Day(Now),2) & Right("0"&Hour(Now),2) & Right("0"&Minute(Now),2) & Right("0"&Second(Now),2) & Int(9 * Rnd) & Int(9 * Rnd) & Int(9 * Rnd) & Int(9 * Rnd) & Right(FileName,Len(FileName)-InStrRev(FileName,".")+1)
  End If
  Dim objRS
  Set objRS=objConn.Execute("SELECT * FROM [blog_UpLoad] WHERE [ul_FileName] = '" & FileName & "'")
  If (Not objRS.bof) And (Not objRS.eof) Then
   '不能重名
    Call ShowError(28)
  Else
   PostTime=Now()
   objConn.Execute("INSERT INTO [blog_UpLoad]([ul_AuthorID],[ul_FileSize],[ul_FileName],[ul_PostTime]) VALUES ("& AuthorID &","& FileSize &",'"& FileName &"','"& PostTime &"')")
   Dim objStreamFile
   Set objStreamFile = Server.CreateObject("ADODB.Stream")
   objStreamFile.Type = adTypeBinary
   objStreamFile.Mode = adModeReadWrite
   objStreamFile.Open
   objStreamFile.Write Stream
   objStreamFile.SaveToFile BlogPath & "/"& ZC_UPLOAD_DIRECTORY &"/" & FileName,adSaveCreateOverWrite
   objStreamFile.Close
  End If
  UpLoad=True[/code]

嗯..是的..

测试成功,如果我想定义到图片右下方,应该怎么改?

这个好,先收藏了

暂时不想用。。

回复 6# 的帖子

我也想知道,,
我测试成功了.,..
位置按这个去改,,,可是我不懂!
Jpeg.OriginalWidth  --宽度
Jpeg.OriginalHeight --长度
Jpeg.OriginalWidth/2-100,Jpeg.OriginalHeight/2+20  意思是w/2-100,h/2+20. 接近中间
你的可以改成 w-x, y
x->你的文字宽度，y-〉你的文字高度 调整一下就行了。

图片小的时候水印很清楚,图片大了根本就看不见,修改了水印字体的大小,小图片的时候光看字就好了!!!:L