VB 给图片添加文字水印

2024-11-05 21:54:27

推荐回答（5个）

回答（1）：

VB6.0给已有图片添加文字可通过定位的Print 方法实现。要将添加文字的位图储存为JPG格式文件，需要使用API函数等实现。

具体步骤：

1）在图片框加载需要添加文字水印的图片。

2）使用如下代码实现添加文字到图片框。

Private Sub CmdEdit_Click() '修改
    Dim strTxt As String
    strTxt = "风雨无阻 拍摄"
    Picture1.FontSize = 18
    Picture1.CurrentY = Picture1.ScaleHeight - 30
    Picture1.CurrentX = Picture1.ScaleWidth / 2 - Picture1.TextWidth(strTxt) / 2
    Picture1.ForeColor = vbWhite
    Picture1.FontItalic = True
    Picture1.Print strTxt
End Sub

3）将以下API转换图片格式代码放置于标准模块，模块命名为saveApg。

Option Explicit
    Public Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type
    Public Type GdiplusStartupInput
        GdiplusVersion As Long
        DebugEventCallback As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs As Long
    End Type
    Public Type EncoderParameter
        GUID As GUID
        NumberOfValues As Long
        type As Long
        Value As Long
    End Type
    Public Type EncoderParameters
        Count As Long
        Parameter As EncoderParameter
    End Type
    Public Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) As Long
    Public Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
    Public Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
    Public Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
    Public Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal fileName As Long, clsidEncoder As GUID, encoderParams As Any) As Long
    Public Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
    Public Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal fileName As Long, Bitmap As Long) As Long

Public Function PictureBoxSaveJPG(ByVal pict As StdPicture, ByVal fileName As String, Optional ByVal quality As Byte = 80) As Boolean
    Dim tSI As GdiplusStartupInput
    Dim lRes As Long
    Dim lGDIP As Long
    Dim lBitmap As Long
    '初始化 GDI+
    tSI.GdiplusVersion = 1
    lRes = GdiplusStartup(lGDIP, tSI, 0)
    If lRes = 0 Then
        '从句柄创建 GDI+ 图像
        lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
        
        If lRes = 0 Then
            Dim tJpgEncoder As GUID
            Dim tParams As EncoderParameters
            
            '初始化解码器的GUID标识
            CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
            
            '设置解码器参数
            tParams.Count = 1
            With tParams.Parameter ' Quality
                '得到Quality参数的GUID标识
                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
                .NumberOfValues = 1
                .type = 4
                .Value = VarPtr(quality)
            End With
            
            '保存图像
            lRes = GdipSaveImageToFile(lBitmap, StrPtr(fileName), tJpgEncoder, tParams)
            
            '销毁GDI+图像
            GdipDisposeImage lBitmap
        End If
        
        '销毁 GDI+
        GdiplusShutdown lGDIP
    End If
    
    If lRes Then
        PictureBoxSaveJPG = False
    Else
        PictureBoxSaveJPG = True
    End If
End Function

4）使用以下代码实现将加好文字水印图片保存为jpg格式图片。

Private Sub Command3_Click() '保存为.jpg图片
    ' 设置“CancelError”为 True
    CommonDialog1.CancelError = True
    On Error GoTo ErrHandler
    ' 设置标志
    CommonDialog1.Flags = cdlOFNHideReadOnly
    ' 设置过滤器
    CommonDialog1.Filter = "JPEG Files" & "(*.jpg)|*.jpg"
    ' 指定缺省的过滤器
    CommonDialog1.FilterIndex = 2
    ' 显示“打开”对话框
    CommonDialog1.ShowSave
    ' 显示选定文件的名字
    'MsgBox CommonDialog1.fileName
    Set Picture2.Picture = Picture1.Image '转移Picture1所绘图为Picture2.Picture赋值
    Dim ret As Boolean
    ret = PictureBoxSaveJPG(Picture2, CommonDialog1.fileName) '保存压缩后的图片
    If ret = False Then
        MsgBox "保存失败"
    End If
    Exit Sub
ErrHandler:
    ' 用户按了“取消”按钮
    Exit Sub
End Sub

回答（2）：

jpg属于有损压缩图像格式，是以牺牲图像质量来获得高压缩率的。一般来说，不管是用什么方法把图像保存为jpg格式，都会有选项让你选择jpg的图像质量的，你说PhotoShop保存的jpg图像其文字仍然清晰，是因为PhotoShop默认采用的jpg图像质量是较高的（貌似是80%），如果把这个参数调低，效果也一样是惨不忍睹的。jpg属于一种业界标准，在条件相同的情况下（比如同一张图片、同样的压缩参数），不管用什么方式做出来的效果都是一样的，不会说PhotoShop效果好而其他软件就不好。所以你应该在保存jpg的时候调整好参数，找到图像质量与图像容量之间的平衡点，“又想马儿跑得快，又想马儿少吃草”的好事是不存在的。

回答（3）：

其实不用这么麻烦。用一些简单的。例如用PS，把文字水印或者图案水印打上去，让后调整水印位置，最后把水印图层的透明度调低，让后保存为jpg格式，这样的效果比起正规水印操作差不了多少

回答（4）：

Private Sub Command1_Click()
AddTxtToPicAndSave Picture1, "文字水印", 100, 200, "c:\1.bmp", 0
End Sub

Private Sub AddTxtToPicAndSave(Picture As PictureBox, strText As String, x As Long, y As Long, SFile As String, SaveType As Integer)
With Picture
.AutoRedraw = True
.CurrentX = x
.CurrentY = y
.Font = "黑体"
.FontBold = True
.ForeColor = vbRed
.FontSize = 22
Picture.Print strText
Select Case SaveType
Case 0 'BMP
SavePicture .Image, SFile
Case 1
'需要第三方控件来保存为其它图像格式
End Select
End With
End Sub

回答（5）：

我发一个之前我用过的在网上找到的代码，可以解决你的问题；
需要请发邮箱