html图片水印的代码,简单实用的给图片加水印源代码

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

在窗体上添加3个图片框，窗体和图片框的ScaleMode属性都设为3，AutoRedraw属性都设为True，其中Picture1加载背景图像，Size要大一点，水印也将要加在这上面；Picture2加载水印图像，Size要小一点；Picture3也要小一点，它打印水印文字。

再添加2个按纽，点击Command1，把Picture2上的图像加到Picture1上，点击Command2，把Picture3上的文字加到Picture1上。

水印可调节透明度，其值在10-90之间选择，此值越大越透明。

文字颜色、字体以及水印位置可自由设置。

你可以只加图像水印或只加文字水印，也可两者都加。

代码较简单，不多说了。

Option Explicit

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 = 80

For y1 = 0 To Picture2.ScaleHeight - 1

x2 = 30

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 = 100

st = "编程爱好者" '水印文字

c2 =

&HFF& '文字为红色

With Picture3

.FontSize = 14

.FontBold = True

.ForeColor = c2

.Width = .TextWidth(st) + 2

.Height = .TextHeight(st) + 2

.Cls

Picture3.Print st

.Refresh

End With

For y1 = 0 To Picture3.Height - 1

x2 = 40

For x1 = 0 To Picture3.Width - 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