想把图片用VB.NET加个水印

lin7516 2015-04-01 11:08:30

想把图片用VB.NET加个水印，并且水印可以移动。请问各位老师这个怎么弄。

...全文

498 20 打赏收藏转发到动态举报

写回复

用AI写文章

20 条回复

切换为时间正序

请发表友善的回复…

发表回复

Tiger_Zhao 2015-04-03

打赏
举报

自动缩放显示的绿框和 rcWatermark 不一致了啊，点下去的位置不在 rcWatermark 中，怎么开始拖动？

lin7516 2015-04-03

打赏
举报

还有个问题就是当picImage.SizeMode = PictureBoxSizeMode.StretchImage就无法拖动。

郗晓勇 2015-04-03

打赏
举报

http://goobbe.com/questions/3261184/can-i-add-watermark-on-a-series-of-pictures

lin7516 2015-04-02

打赏
举报

大神在吗？

lin7516 2015-04-02

打赏
举报

哪位哥哥帮我把这代码改为VB.NET啊。 Private Type BitMap bmType As Long '图像类型：0 表示是位图 bmWidth As Long '图像宽度（像素） bmHeight As Long '图像高度（像素） bmWidthBytes As Long '每一行图像的字节数 bmPlanes As Integer '图像的图层数 bmBitsPixel As Integer '图像的位数 bmBits As Long '位图的内存指针 End Type Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long Private Type tyRGB R As Long: G As Long: B As Long End Type Dim ctIsText As Boolean, ctRun As Boolean, ctF As String Private Sub Form_Load() Me.Caption = "水印" Me.ScaleMode = 3 Picture1.AutoRedraw = True: Picture1.ScaleMode = 3 '持久位图输出，量度单位 Picture2.AutoRedraw = True: Picture2.ScaleMode = 3 Picture1.AutoSize = True: Picture2.AutoSize = True ctRun = True ' Shape1.Visible = False Shape1.Move 0, 0 End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Dim W As Long, H As Long If Button <> 1 Then Exit Sub W = Picture2.ScaleWidth: H = Picture2.ScaleHeight 'VB.NET用自己找到了:Me.DisplayRectangle.Width Me.DisplayRectangle.Height Shape1.Move x - W * 0.5, y - H * 0.5, W, H Shape1.Visible = True End Sub Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Or Not Shape1.Visible Then Exit Sub ' Shape1.Visible = False Call AddWater(ctIsText) End Sub Private Sub Command2_Click() Call AddWater '图片水印 End Sub Private Sub AddWater(Optional IsText As Boolean) 'Optional参数可选 Dim S1 As Long, W1 As Long, H1 As Long, BM1() As Byte, Bs1 As Long, BytesW1 As Long, Ps1 As Long Dim S2 As Long, W2 As Long, H2 As Long, BM2() As Byte, Bs2 As Long, BytesW2 As Long, Ps2 As Long Dim R As Long, G As Long, B As Long, Tmp As Long, Tmp1 As Long, Tmp2 As Long Dim MaxSe As tyRGB, MinSe As tyRGB, BackSe As tyRGB, nStr As String Dim x As Long, y As Long, x0 As Long, y0 As Long, Bi As Single, nMode As Long Dim W As Long, Range As Long, x1 As Long, y1 As Long, x2 As Long, y2 As Long If Not ctRun Then Exit Sub '防止初始化时多次重复调用 Bi = Val(1) '水印的清晰度 0 到 1 Picture1.Cls Picture1.Refresh GetBmpDat Picture1, W1, H1, BM1, Bs1, BytesW1, Ps1 GetBmpDat Picture2, W2, H2, BM2, Bs2, BytesW2, Ps2 x0 = Shape1.Left: y0 = Shape1.Top '水印显示位置 x1 = -x0: y1 = -y0 If x1 < 0 Then x1 = 0 If y1 < 0 Then y1 = 0 x2 = W2 - 1: y2 = H2 - 1 If x2 > W1 - x0 - 1 Then x2 = W1 - x0 - 1 If y2 > H1 - y0 - 1 Then y2 = H1 - y0 - 1 For x = x1 To x2 For y = y1 To y2 S2 = XYtoIndex(x, y, BytesW2, Ps2) '像素点在数组 BM2 中的索引:水印底稿 R = BM2(S2 + 2): G = BM2(S2 + 1): B = BM2(S2) S1 = XYtoIndex(x0 + x, y0 + y, BytesW1, Ps1) '像素点在数组 BM1 中的索引 BM1(S1 + 2) = SeAdd(BM1(S1 + 2), R, Bi) BM1(S1 + 1) = SeAdd(BM1(S1 + 1), G, Bi) BM1(S1) = SeAdd(BM1(S1), B, Bi) Next Next Text1 = "x " & S1 & "y " & Ps2 SetBitmapBits Picture1.Image, Bs1, BM1(0) '将 Picture1 的图像设置为旋转后的二进数组 BM1() End Sub Private Sub GetBmpDat(Kj As Control, W As Long, H As Long, B() As Byte, Bs As Long, BytesW As Long, Ps As Long) '获取控件 Kj 的图像数据 Dim MapInf As BitMap GetObject Kj.Image, Len(MapInf), MapInf '用 MapInf 得到 Kj 的图像信息 W = MapInf.bmWidth H = MapInf.bmHeight '图像宽度、高度（像素） BytesW = MapInf.bmWidthBytes '每行占用字节数 Ps = BytesW \ W '每个像素字节数(一般为4) Bs = W * H * Ps '总字节数=宽度*高度*每个像素字节 ReDim B(0 To Bs - 1) GetBitmapBits Kj.Image, Bs, B(0) '将 Kj 图像所有像素点的颜色值读入二进数组 B() End Sub Private Function XYtoIndex(x As Long, y As Long, BytesW As Long, Ps As Long) As Long '返回图像坐标 x,y 在颜色数组中的序号位置。 'BytesW：每行图像占用字节数，Ps：每个像素点占用字节数(一般为4) XYtoIndex = y * BytesW + x * Ps End Function Private Function SeAdd(ByVal Se1 As Long, ByVal Se2 As Long, Bi2 As Single) As Long '两种单通道颜色叠加，Bi2 表示 Se2 的比例 SeAdd = Se1 + (Se2 - Se1) * Bi2 End Function

lin7516 2015-04-02

打赏
举报

引用 16 楼 Tiger_Zhao 的回复:

Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "
	...
#End Region

    Private watermark_bm As Bitmap
    Private source_bm As Bitmap
    Private rcWatermark As Rectangle
    Private ptLast As Point
    Private isDraging As Boolean = False

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        watermark_bm = New Bitmap(picWatermark2.Image)
        source_bm = New Bitmap(System.IO.Path.Combine(Application.StartupPath, "..\dog.jpg"))

        rcWatermark = New Rectangle((source_bm.Width - source_bm.Width) \ 2, _
                                    2 * (source_bm.Height - source_bm.Height) \ 3, _
                                    watermark_bm.Width, _
                                    watermark_bm.Height)
        RedrawImage()
    End Sub

    Private Sub picImage_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picImage.MouseDown
        If e.Button = MouseButtons.Left Then
            If rcWatermark.Contains(e.X, e.Y) Then
                ptLast = New Point(e.X, e.Y)
                isDraging = True
            End If
        End If
    End Sub

    Private Sub picImage_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picImage.MouseMove
        If isDraging Then
            rcWatermark.Offset(e.X - ptLast.X, e.Y - ptLast.Y)
            ptLast = New Point(e.X, e.Y)
            RedrawImage()
        End If
    End Sub

    Private Sub picImage_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picImage.MouseUp
        isDraging = False
    End Sub

    Private Sub RedrawImage()
        Dim result_bm As New Bitmap(picImage.Image)
        DrawBackground(source_bm, result_bm)
        DrawBorder(result_bm)
        DrawWatermark(watermark_bm, result_bm, rcWatermark.X, rcWatermark.Y)
        picImage.Image = result_bm
    End Sub

    Private Sub DrawBackground(ByVal back_bm As Bitmap, ByVal result_bm As Bitmap)
        Dim gr As Graphics = Graphics.FromImage(result_bm)
        gr.DrawImage(back_bm, 0, 0)
    End Sub

    Private Sub DrawBorder(ByVal result_bm As Bitmap)
        Dim gr As Graphics = Graphics.FromImage(result_bm)
        Dim greenPen As New Pen(Color.Green)
        gr.DrawRectangle(greenPen, rcWatermark)
    End Sub

    ' Copy the watermark image over the result image.
    Private Sub DrawWatermark(ByVal watermark_bm As Bitmap, ByVal result_bm As Bitmap, ByVal x As Integer, ByVal y As Integer)
        Const ALPHA As Byte = 128
        ' Set the watermark's pixels' Alpha components.
        Dim clr As Color
        For py As Integer = 0 To watermark_bm.Height - 1
            For px As Integer = 0 To watermark_bm.Width - 1
                clr = watermark_bm.GetPixel(px, py)
                watermark_bm.SetPixel(px, py, Color.FromArgb(ALPHA, clr.R, clr.G, clr.B))
            Next px
        Next py

        ' Set the watermark's transparent color.
        watermark_bm.MakeTransparent(watermark_bm.GetPixel(0, 0))

        ' Copy onto the result image.
        Dim gr As Graphics = Graphics.FromImage(result_bm)
        gr.DrawImage(watermark_bm, x, y)
    End Sub
End Class

哥，谢谢啦，高人啊。

Tiger_Zhao 2015-04-02

打赏
举报

Public Class Form1

    Inherits System.Windows.Forms.Form



#Region " Windows Form Designer generated code "

	...

#End Region



    Private watermark_bm As Bitmap

    Private source_bm As Bitmap

    Private rcWatermark As Rectangle

    Private ptLast As Point

    Private isDraging As Boolean = False



    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        watermark_bm = New Bitmap(picWatermark2.Image)

        source_bm = New Bitmap(System.IO.Path.Combine(Application.StartupPath, "..\dog.jpg"))



        rcWatermark = New Rectangle((source_bm.Width - source_bm.Width) \ 2, _

                                    2 * (source_bm.Height - source_bm.Height) \ 3, _

                                    watermark_bm.Width, _

                                    watermark_bm.Height)

        RedrawImage()

    End Sub



    Private Sub picImage_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picImage.MouseDown

        If e.Button = MouseButtons.Left Then

            If rcWatermark.Contains(e.X, e.Y) Then

                ptLast = New Point(e.X, e.Y)

                isDraging = True

            End If

        End If

    End Sub



    Private Sub picImage_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picImage.MouseMove

        If isDraging Then

            rcWatermark.Offset(e.X - ptLast.X, e.Y - ptLast.Y)

            ptLast = New Point(e.X, e.Y)

            RedrawImage()

        End If

    End Sub



    Private Sub picImage_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picImage.MouseUp

        isDraging = False

    End Sub



    Private Sub RedrawImage()

        Dim result_bm As New Bitmap(picImage.Image)

        DrawBackground(source_bm, result_bm)

        DrawBorder(result_bm)

        DrawWatermark(watermark_bm, result_bm, rcWatermark.X, rcWatermark.Y)

        picImage.Image = result_bm

    End Sub



    Private Sub DrawBackground(ByVal back_bm As Bitmap, ByVal result_bm As Bitmap)

        Dim gr As Graphics = Graphics.FromImage(result_bm)

        gr.DrawImage(back_bm, 0, 0)

    End Sub



    Private Sub DrawBorder(ByVal result_bm As Bitmap)

        Dim gr As Graphics = Graphics.FromImage(result_bm)

        Dim greenPen As New Pen(Color.Green)

        gr.DrawRectangle(greenPen, rcWatermark)

    End Sub



    ' Copy the watermark image over the result image.

    Private Sub DrawWatermark(ByVal watermark_bm As Bitmap, ByVal result_bm As Bitmap, ByVal x As Integer, ByVal y As Integer)

        Const ALPHA As Byte = 128

        ' Set the watermark's pixels' Alpha components.

        Dim clr As Color

        For py As Integer = 0 To watermark_bm.Height - 1

            For px As Integer = 0 To watermark_bm.Width - 1

                clr = watermark_bm.GetPixel(px, py)

                watermark_bm.SetPixel(px, py, Color.FromArgb(ALPHA, clr.R, clr.G, clr.B))

            Next px

        Next py



        ' Set the watermark's transparent color.

        watermark_bm.MakeTransparent(watermark_bm.GetPixel(0, 0))



        ' Copy onto the result image.

        Dim gr As Graphics = Graphics.FromImage(result_bm)

        gr.DrawImage(watermark_bm, x, y)

    End Sub

End Class

lin7516 2015-04-02

打赏
举报

引用 14 楼 Tiger_Zhao 的回复:

Add a watermark to an image in VB .NET 实心空心的都有了，函数也是指定位置输出的，你自己实现拖到功能就成了。

我的代码就是出自这里，可是我不知道怎么实现拖放功能。

Tiger_Zhao 2015-04-02

打赏
举报

Add a watermark to an image in VB .NET
实心空心的都有了，函数也是指定位置输出的，你自己实现拖到功能就成了。

lin7516 2015-04-01

打赏
举报

我是菜鸟求代码。望不惜赐教。

娃都会打酱油了 2015-04-01

打赏
举报

当然可以，已添加水印的是不可能的，你可以展示图片，比如Panel，设置背景图片为你要加水印的图片，然后你的水印用一个label加在panel里面，根据最终label拖到的位置的顶点，来设置图片添加水印时的位置

lin7516 2015-04-01

打赏
举报

引用 4 楼 starfd 的回复:

能把加水印的那段代码贴下吗，哪个方法参数里面有position相关的坐标的，改那几个值就可以调整水印位置了

Dim srcImg As System.Drawing.Image Dim wmImage As System.Drawing.Image Dim g As Graphics Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click On Error Resume Next 'If TextBox1.Text <> "" And TextBox2.Text <> "" And TextBox3.Text <> "" Then srcImg = System.Drawing.Image.FromFile("C:\Documents and Settings\Administrator\桌面\M085157 合同.jpg") '大图片 wmImage = System.Drawing.Image.FromFile("C:\Documents and Settings\Administrator\桌面\11.jpg") '小图片 g = Graphics.FromImage(srcImg) g.DrawImage(wmImage, New Rectangle(500, 1200, 600, 600), 0, 0, wmImage.Width, wmImage.Height, GraphicsUnit.Pixel) srcImg.Save(TextBox3.Text) srcImg.Dispose() wmImage.Dispose() g.Dispose() 'End If PictureBox1.Image = Image.FromFile(TextBox3.Text) End Sub 这个我知道，可是调整的位置不准确，不实时，能不能用鼠标拖动水印图片，调整位置啊。

娃都会打酱油了 2015-04-01