简单实用的给图片加水印源代码[VB]

  在窗体上添加3个图片框,它们的ScaleMode属性都设为3,AutoRedraw属性都设为True,其中Picture1加载背景图像,Size要大一点,水印也将要加在这上面;Picture2加载水印图像,Size要小一点;Picture3打印水印文字。
  再添加2个按纽,点击Command1时,就把Picture2上的图像加到Picture1上,点击Command2时,则把Picture3上的文字加到Picture1上。
  水印可调节透明度,其值在10-90之间选择,此值越大越透明。
  文字颜色、字体以及水印位置可自由设置。
  你可以只加图像水印或只加文字水印,也可两者都加。
  代码较简单,不多说了。

Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x
As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As
Long, ByVal y As Long) As Long

Private Sub Command1_Click()     '加水印图像
Dim transparence As Integer      '水印透明度
Dim x1 As Integer, y1 As Integer '水印图取点坐标
Dim x2 As Integer, y2 As Integer '背景图上的水印位置坐标
Dim c As Long
Dim r1 As Integer, g1 As Integer, b1 As Integer
Dim r2 As Integer, g2 As Integer, b2 As Integer

transparence = 50                '此值在 10-90 之间,越大越透明
y2 = (Picture1.Height - Picture2.Height) / 15 - 20

For y1 = 0 To Picture2.ScaleHeight - 1
  x2 = (Picture1.Width - Picture2.Width) / 15 - 20
  For x1 = 0 To Picture2.ScaleWidth - 1

    c = GetPixel(Picture2.hdc, x1, y1) '从水印图像取点
    r1 = c Mod 256
    g1 = c \ 256 Mod 256
    b1 = c \ 256 \ 256

    c = GetPixel(Picture1.hdc, x2, y2) '从背景图像取点
    r2 = c Mod 256
    g2 = c \ 256 Mod 256
    b2 = c \ 256 \ 256

    r1 = r1 - transparence * (r1 - r2) / 100
    g1 = g1 - transparence * (g1 - g2) / 100
    b1 = b1 - transparence * (b1 - b2) / 100

    SetPixelV Picture1.hdc, x2, y2, RGB(r1, g1, b1)
    x2 = x2 + 1
  Next
  y2 = y2 + 1
Next

Picture1.Refresh
End Sub


Private Sub Command2_Click()     '加水印字符
Dim transparence As Integer      '水印透明度
Dim x1 As Integer, y1 As Integer '水印字符图取点坐标
Dim x2 As Integer, y2 As Integer '背景图上的水印位置坐标
Dim c1 As Long, c2 As Long
Dim r1 As Integer, g1 As Integer, b1 As Integer
Dim r2 As Integer, g2 As Integer, b2 As Integer
Dim st As String

transparence = 50
y2 = (Picture1.Height - Picture3.Height) / 15 - 20
st = "编程爱好者" '水印文字
c2 = vbWhite      '文字颜色

With Picture3
  .FontSize = 14
  .FontBold = True
  .ForeColor = c2
  .Width = .TextWidth(st) * 15 + 60
  .Height = .TextHeight(st) * 15 + 60
  .Cls
  Picture3.Print st
  .Refresh
With

For y1 = 0 To Picture3.ScaleHeight - 1
  x2 = (Picture1.Width - Picture3.Width) / 15 - 20
  For x1 = 0 To Picture3.ScaleWidth - 1
    c1 = GetPixel(Picture3.hdc, x1, y1) '从水印字符图取点
    If c1 = c2 Then
      r1 = c1 Mod 256
      g1 = c1 \ 256 Mod 256
      b1 = c1 \ 256 \ 256

      c1 = GetPixel(Picture1.hdc, x2, y2) '从背景图像取点
      r2 = c1 Mod 256
      g2 = c1 \ 256 Mod 256
      b2 = c1 \ 256 \ 256

      r1 = r1 - transparence * (r1 - r2) / 100
      g1 = g1 - transparence * (g1 - g2) / 100
      b1 = b1 - transparence * (b1 - b2) / 100

      SetPixelV Picture1.hdc, x2, y2, RGB(r1, g1, b1)
    End If
    x2 = x2 + 1
  Next
  y2 = y2 + 1
Next

Picture1.Refresh
End Sub

上一篇: 请上传phpcms2007版config.inc.php文件到根目录?
下一篇: Lenka - Trouble Is a Friend[LRC]
文章来自: newsfan.net
引用通告: 查看所有引用 | 我要引用此文章
Tags: VB VisualBasic 水印 图片 源码
相关日志:
评论: 0 | 引用: 0 | 查看次数: 8082
发表评论
昵 称:
密 码: 游客发言不需要密码.
邮 箱: 邮件地址支持Gravatar头像,邮箱地址不会公开.
网 址: 输入网址便于回访.
内 容:
验证码:
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.
字数限制 500 字 | UBB代码 关闭 | [img]标签 关闭