主题:[原创]简单实用的给图片加水印源代码
一江秋水
[专家分:9680] 发布于 2010-11-22 18:17:00
在窗体上添加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 color 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
color = GetPixel(Picture2.hdc, x1, y1) '从水印图像取点
r1 = color Mod 256
g1 = color \ 256 Mod 256
b1 = color \ 256 \ 256
color = GetPixel(Picture1.hdc, x2, y2) '从背景图像取点
r2 = color Mod 256
g2 = color \ 256 Mod 256
b2 = color \ 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 color 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 = "编程爱好者"
Picture3.Width = Picture3.TextWidth(st) * 15 + 60
Picture3.Height = Picture3.TextHeight(st) * 15 + 60
Picture3.ForeColor = vbWhite
Picture3.FontSize = 14
Picture3.FontBold = True
Picture3.Cls
Picture3.Print st
Picture3.Refresh
For y1 = 0 To Picture3.ScaleHeight - 1
x2 = (Picture1.Width - Picture3.Width) / 15 - 20
For x1 = 0 To Picture3.ScaleWidth - 1
color = GetPixel(Picture3.hdc, x1, y1) '从水印字符图取点
If color = vbWhite Then
r1 = color Mod 256
g1 = color \ 256 Mod 256
b1 = color \ 256 \ 256
color = GetPixel(Picture1.hdc, x2, y2) '从背景图像取点
r2 = color Mod 256
g2 = color \ 256 Mod 256
b2 = color \ 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
最后更新于:2010-11-22 18:22:00
回复列表 (共19个回复)
沙发
rongduo [专家分:70] 发布于 2010-11-23 08:03:00
很好的东东。不过水印完成后,是否可以导出加水印的图片文件?哦,图片框控件我真的还没用过。
板凳
一江秋水 [专家分:9680] 发布于 2010-11-23 16:21:00
当然可以的
3 楼
booxincn [专家分:10] 发布于 2010-11-26 21:23:00
很不错的编码。正要写这样的论文
数字水印的基础知识 1
1.1信息隐藏技术简介 1
1.2 数字水印技术的背景 2
1.3 数字水印的定义和原理 3
1.3.1 数字水印的定义 3
1.3.2 数字水印的原理 3
1.4数字水印的分类 3
1.5 数字水印的基本特性 5
1.6 数字水印的主要应用领域 6
1.7 数字水印技术今后的研究发展空间 7
数字水印的主要算法 8
2.1频域算法 8
2.2 文本算法 9
2.3 统计学算法 9
2.4 压缩域算法 10
2.5 生理模型算法 10
本文空域算法的描述 10
3.1 二值图像 10
3.2 水印嵌入 11
3.3 水印提取 11
3.4 水印判断 11
3.5 数字水印基本框架图 12
数字水印编程的实现 14
4.1 Delphi 简介 14
4.2 Delphi的基本特性 14
4.3 数字水印界面的设计 15
4.4 数字水印程序的设计 16
4.5 运行结果 21
总 结 24
致谢 25
参考文献 25
附 录 25
http://www.bysjonline.com/Software/catalog8/604.html
4 楼
dfsafds [专家分:30] 发布于 2010-12-03 13:09:00
Asian wives [url=http://www.mmopowerlevel.net]wow power leveling[/url] are more approachable than the Western wives:
There is no doubt about this fact. If [url=http://www.mogxe.com/PowerLevel.php?gid=1]wow power leveling[/url] you will say an Asian female that she is beautiful, she will give you a smile in a respectful way. This [url=http://www.mmopowerlevel.net/powerlist.php?fid=688]wow power leveling[/url] is not possible in case of most of the western women. This is because [url=http://www.mmopowerlevel.net/buy.php]world of warcraft gold[/url] it is in their culture and tradition to smile and treat every one with gratitude. For an instance, visit Philippines provinces, people are so poor but still [url=http://www.mmopowerlevel.net/buy.php]best wow gold[/url] they will welcome you with a smile. Another fact is that Asian females are shyer than the western females but once you will treat them in a friendly manner, they [url=http://www.mmopowerlevel.net/buy.php]cheapest wow gold[/url] will always welcome you with respect.This combination is completely irresistible. Asian females with oriental features are having expressionless face structure. Therefore, they have [url=http://www.mmopowerlevel.net/powerlist.php?fid=7422]cheap aion power leveling[/url] an air of unpredictability and enigma. Males mostly love this secretive feature and admire it.
5 楼
ypspark [专家分:0] 发布于 2010-12-11 21:13:00
Asian wives wow power leveling are more approachable than the Western wives:
There is no doubt about this fact. If wow power leveling you will say an Asian female that she is beautiful, she will give you a smile in a respectful way. This wow power leveling is not possible in case of most of the western women. This is because world of warcraft gold it is in their culture and tradition to smile and treat every one with gratitude. For an instance, visit Philippines provinces, people are so poor but still best wow gold they will welQQ空间www.qqcnn.com QQ签名www.qq718.com QQ网名www.qq719.com QQ免费代码www.qq710.com QQ代码www.qq760.com come you with a smile. Another fact is that Asian females are shyer than the western females but once you will treat them in a friendly manner, they cheapest wow gold will always welcome you with respect.This combination is completely irresistible. Asian females with oriental features are having expressionless face structure. Therefore, they have cheap aion power leveling an air of unpredictability and enigma. Males mostly love this secretive feature and admire it.
6 楼
Isaactom [专家分:20] 发布于 2011-01-06 11:01:00
不错,楼主花了功夫的啊
7 楼
jasonstanli [专家分:20] 发布于 2011-01-14 09:59:00
好东西啊 楼主辛苦了!
[url=http://www.shzhibingchang.com]上海制冰厂[/url]
8 楼
wulove124543 [专家分:10] 发布于 2011-01-27 16:10:00
很不错的编码。
[color=#66CCCC]SINGATURE[/color][color=gray]-------------------------------------------------------------[/color]
[url=http://www.alsduntel.com]阿里斯顿热水器维修电话[/url]
9 楼
mengweidsg [专家分:40] 发布于 2011-03-23 20:36:00
有点意思
biaozhun.zhao@meitipu.com
biaozhun.tan@meitipu.com
biaozhun.liao@meitipu.com
10 楼
cchmhao2010 [专家分:10] 发布于 2011-04-27 17:55:00
[url=http://www.worldgodshop.com/]Supra Shoes[/url] [url=http://www.worldgodshop.com/]Radii shoes[/url] [url=http://www.worldgodshop.com/]Prada Shoes[/url] [url=http://www.worldgodshop.com/]Jordan shoes[/url] [url=http://www.worldgodshop.com/]Christian Louboutin shoes[/url]
http://www.worldgodshop.com/
我来回复