Adding a Watermark to an Image Using The GDI+ API

This is my 6th and final article in my series looking at using the GDI+ API(s) to working with images:

Today, I decided to demonstrate how you can add a textual watermark to an image.

GDI+ API(s) offer a full range of capabilities that go well beyond this article and it can draw shapes (rectangle, circles, ellipses, …) and much, much more!  So if you need more advanced editing capabilities do look further into GDI+ as it most probably will be able to do the job.

The Code

To write on an image we will use the GdipDrawString function, but to do so we first have to use several other GDI+ API functions to define the font, font styles and then also define a brush to draw it with.

Enough talk, here’s the code.

Option Explicit

'API Declarations, ENUMS, TYPES, Global Variables, ...
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
Private Const GdiPlusVersion  As Long = 1

Private Const ImageCodecBMP = "{557CF400-1A04-11D3-9A73-0000F81EF32E}"
Private Const ImageCodecGIF = "{557CF402-1A04-11D3-9A73-0000F81EF32E}"
Private Const ImageCodecJPG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Private Const ImageCodecPNG = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"
Private Const ImageCodecTIF = "{557CF405-1A04-11D3-9A73-0000F81EF32E}"
Private Const EncoderQuality = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Private Const EncoderCompression = "{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"
Private Const TiffCompressionNone = 6
Private Const EncoderParameterValueTypeLong = 4

Private Type GUID
    Data1                     As Long
    Data2                     As Integer
    Data3                     As Integer
    Data4(0 To 7)             As Byte
End Type

Private Type GDIPlusStartupInput
    GdiPlusVersion            As Long
    DebugEventCallback        As Long
    SuppressBackgroundThread  As Long
    SuppressExternalCodecs    As Long
End Type

Private Type EncoderParameter
    GUID                      As GUID
    NumberOfValues            As Long
    type                      As Long
    Value                     As Long
End Type

Private Type EncoderParameters
    Count                     As Long
    Parameter(15)             As EncoderParameter
End Type

Private Type RECTF
    Left                      As Single
    Top                       As Single
    Right                     As Single
    Bottom                    As Single
End Type

'GDI+ Status Constants
Public Enum Status
    'https://docs.microsoft.com/en-us/windows/win32/api/gdiplustypes/ne-gdiplustypes-status
    OK = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum

Public Enum StringAlignment
    StringAlignmentNear = &H0
    StringAlignmentCenter = &H1
    StringAlignmentFar = &H2
End Enum

'Image Property Tag Constants
Public Enum PropertyTagId
    'https://docs.microsoft.com/en-us/windows/win32/gdiplus/-gdiplus-constant-property-tags-in-alphabetical-order
    'https://docs.microsoft.com/en-us/windows/win32/gdiplus/-gdiplus-constant-property-tags-in-numerical-order
    '   0x0... => &H...
    '   https://docs.microsoft.com/en-us/windows/win32/gdiplus/-gdiplus-constant-property-item-descriptions
    GpsVer = 0    '&H0&
    GpsLatitudeRef = 1    '&H1&
    GpsLatitude = 2    '&H2&
    GpsLongitudeRef = 3    '&H3&
    GpsLongitude = 4    '&H4&
    GpsAltitudeRef = 5    '&H5&
    GpsAltitude = 6    '&H6&
    GpsGpsTime = 7    '&H7&
    GpsGpsSatellites = 8    '&H8&
    GpsGpsStatus = 9    '&H9&
    GpsGpsMeasureMode = 10    '&HA&
    GpsGpsDop = 11    '&HB&
    GpsSpeedRef = 12    '&HC&
    GpsSpeed = 13    '&HD&
    GpsTrackRef = 14    '&HE&
    GpsTrack = 15    '&HF&
    GpsImgDirRef = 16    '&H10&
    GpsImgDir = 17    '&H11&
    GpsMapDatum = 18    '&H12&
    GpsDestLatRef = 19    '&H13&
    GpsDestLat = 20    '&H14&
    GpsDestLongRef = 21    '&H15&
    GpsDestLong = 22    '&H16
    GpsDestBearRef = 23    '&H17&
    GpsDestBear = 24    '&H18&
    GpsDestDistRef = 25    '&H19&
    GpsDestDist = 26    '&H1A&
    NewSubfileType = 254    '&HFE&
    SubfileType = 255    '&HFF&
    ImageWidth = 256    '&H100&
    ImageHeight = 257    '&H101&
    BitsPerSample = 258    '&H102&
    Compression = 259    '&H103&
    PhotometricInterp = 262    '&H106&
    ThreshHolding = 263    '&H107&
    CellWidth = 264    '&H108&
    CellHeight = 265    '&H109&
    FillOrder = 266    '&H10A&
    DocumentName = 269    '&H10D&
    ImageDescription = 270    '&H10E&
    EquipMake = 271    '&H10F&
    EquipModel = 272    '&H110&
    StripOffsets = 273    '&H111&
    Orientation = 274    '&H112&
    SamplesPerPixel = 277    '&H115&
    RowsPerStrip = 278    '&H116&
    StripBytesCount = 279    '&H117&
    MinSampleValue = 280    '&H118&
    MaxSampleValue = 281    '&H119&
    XResolution = 282    '&H11A&
    YResolution = 283    '&H11B&
    PlanarConfig = 284    '&H11C&
    PageName = 285    '&H11D&
    XPosition = 286    '&H11E&
    YPosition = 287    '&H11F&
    FreeOffset = 288    '&H120&
    FreeByteCounts = 289    '&H121&
    GrayResponseUnit = 290    '&H122&
    GrayResponseCurve = 291    '&H123&
    T4Option = 292    '&H124&
    T6Option = 293    '&H125&
    ResolutionUnit = 296    '&H128&
    PageNumber = 297    '&H129&
    TransferFunction = 301    '&H12D&
    SoftwareUsed = 305    '&H131&
    DateTime = 306    '&H132&
    Artist = 315    '&H13B&
    HostComputer = 316    '&H13C&
    Predictor = 317    '&H13D&
    WhitePoint = 318    '&H13E&
    PrimaryChromaticities = 319    '&H13F&
    ColorMap = 320    '&H140&
    HalftoneHints = 321    '&H141&
    TileWidth = 322    '&H142&
    TileLength = 323    '&H143&
    TileOffset = 324    '&H144&
    TileByteCounts = 325    '&H145&
    InkSet = 332    '&H14C&
    InkNames = 333    '&H14D&
    NumberOfInks = 334    '&H14E&
    DotRange = 336    '&H150&
    TargetPrinter = 337    '&H151&
    ExtraSamples = 338    '&H152&
    SampleFormat = 339    '&H153&
    TransferRange = 342    '&H156&
    JPEGProc = 512    '&H200&
    JPEGInterFormat = 513    '&H201&
    JPEGInterLength = 514    '&H202&
    JPEGRestartInterval = 515    '&H203&
    JPEGLosslessPredictors = 517    '&H205&
    JPEGPointTransforms = 518    '&H206&
    JPEGQTables = 519    '&H207&
    JPEGDCTables = 520    '&H208&
    JPEGACTables = 521    '&H209&
    YCbCrCoefficients = 529    '&H211&
    YCbCrSubsampling = 530    '&H212&
    YCbCrPositioning = 531    '&H213&
    REFBlackWhite = 532    '&H214&
    Gamma = 769    '&H301&
    ICCProfileDescriptor = 770    '&H302&
    SRGBRenderingIntent = 771    '&H303&
    ImageTitle = 800    '&H320&
    ResolutionXUnit = 20481    '&H5001&
    ResolutionYUnit = 20482    '&H5002&
    ResolutionXLengthUnit = 20483    '&H5003&
    ResolutionYLengthUnit = 20484    '&H5004&
    PrintFlags = 20485    '&H5005&
    PrintFlagsVersion = 20486    '&H5006&
    PrintFlagsCrop = 20487    '&H5007&
    PrintFlagsBleedWidth = 20488    '&H5008&
    PrintFlagsBleedWidthScale = 20489    '&H5009&
    HalftoneLPI = 20490    '&H500A&
    HalftoneLPIUnit = 20491    '&H500B&
    HalftoneDegree = 20492    '&H500C&
    HalftoneShape = 20493    '&H500D&
    HalftoneMisc = 20494    '&H500E&
    HalftoneScreen = 20495    '&H500F&
    JPEGQuality = 20496    '&H5010&
    GridSize = 20497    '&H5011&
    ThumbnailFormat = 20498    '&H5012&
    ThumbnailWidth = 20499    '&H5013&
    ThumbnailHeight = 20500    '&H5014&
    ThumbnailColorDepth = 20501    '&H5015&
    ThumbnailPlanes = 20502    '&H5016&
    ThumbnailRawBytes = 20503    '&H5017&
    ThumbnailSize = 20504    '&H5018&
    ThumbnailCompressedSize = 20505    '&H5019&
    ColorTransferFunction = 20506    '&H501A&
    ThumbnailData = 20507    '&H501B&
    ThumbnailImageWidth = 20512    '&H5020&
    ThumbnailImageHeight = 20513    '&H5021&
    ThumbnailBitsPerSample = 20514    '&H5022&
    ThumbnailCompression = 20515    '&H5023&
    ThumbnailPhotometricInterp = 20516    '&H5024&
    ThumbnailImageDescription = 20517    '&H5025&
    ThumbnailEquipMake = 20518    '&H5026&
    ThumbnailEquipModel = 20519    '&H5027&
    ThumbnailStripOffsets = 20520    '&H5028&
    ThumbnailOrientation = 20521    '&H5029&
    ThumbnailSamplesPerPixel = 20522    '&H502A&
    ThumbnailRowsPerStrip = 20523    '&H502B&
    ThumbnailStripBytesCount = 20524    '&H502C&
    ThumbnailResolutionX = 20525    '&H502D&
    ThumbnailResolutionY = 20526    '&H502E&
    ThumbnailPlanarConfig = 20527    '&H502F&
    ThumbnailResolutionUnit = 20528    '&H5030&
    ThumbnailTransferFunction = 20529    '&H5031&
    ThumbnailSoftwareUsed = 20530    '&H5032&
    ThumbnailDateTime = 20531    '&H5033&
    ThumbnailArtist = 20532    '&H5034&
    ThumbnailWhitePoint = 20533    '&H5035&
    ThumbnailPrimaryChromaticities = 20534    '&H5036&
    ThumbnailYCbCrCoefficients = 20535    '&H5037&
    ThumbnailYCbCrSubsampling = 20536    '&H5038&
    ThumbnailYCbCrPositioning = 20537    '&H5039&
    ThumbnailRefBlackWhite = 20538    '&H503A&
    ThumbnailCopyRight = 20539    '&H503B&
    LuminanceTable = 20624    '&H5090&
    ChrominanceTable = 20625    '&H5091&
    FrameDelay = 20736    '&H5100&
    LoopCount = 20737    '&H5101&
    GlobalPalette = 20738    '&H5102&
    IndexBackground = 20739    '&H5103&
    IndexTransparent = 20740    '&H5104&
    PixelUnit = 20752    '&H5110&
    PixelPerUnitX = 20753    '&H5111&
    PixelPerUnitY = 20754    '&H5112&
    PaletteHistogram = 20755    '&H5113&
    Copyright = 33432    '&H8298&
    ExifExposureTime = 33434    '&H829A&
    ExifFNumber = 33437    '&H829D&
    ExifIFD = 34665    '&H8769&
    ICCProfile = 34675    '&H8773&
    ExifExposureProg = 34850    '&H8822&
    ExifSpectralSense = 34852    '&H8824&
    GpsIFD = 34853    '&H8825&
    ExifISOSpeed = 34855    '&H8827&
    ExifOECF = 34856    '&H8828&
    ExifVer = 36864    '&H9000&
    ExifDTOrig = 36867    '&H9003&
    ExifDTDigitized = 36868    '&H9004&
    ExifCompConfig = 37121    '&H9101&
    ExifCompBPP = 37122    '&H9102&
    ExifShutterSpeed = 37377    '&H9201&
    ExifAperture = 37378    '&H9202&
    ExifBrightness = 37379    '&H9203&
    ExifExposureBias = 37380    '&H9204&
    ExifMaxAperture = 37381    '&H9205&
    ExifSubjectDist = 37382    '&H9206&
    ExifMeteringMode = 37383    '&H9207&
    ExifLightSource = 37384    '&H9208&
    ExifFlash = 37385    '&H9209&
    ExifFocalLength = 37386    '&H920A&
    ExifMakerNote = 37500    '&H927C&
    ExifUserComment = 37510    '&H9286&
    ExifDTSubsec = 37520    '&H9290&
    ExifDTOrigSS = 37521    '&H9291&
    ExifDTDigSS = 37522    '&H9292&
    ExifFPXVer = 40960    '&HA000&
    ExifColorSpace = 40961    '&HA001&
    ExifPixXDim = 40962    '&HA002&
    ExifPixYDim = 40963    '&HA003&
    ExifRelatedWav = 40964    '&HA004&
    ExifInterop = 40965    '&HA005&
    ExifFlashEnergy = 41483    '&HA20B&
    ExifSpatialFR = 41484    '&HA20C&
    ExifFocalXRes = 41486    '&HA20E&
    ExifFocalYRes = 41487    '&HA20F&
    ExifFocalResUnit = 41488    '&HA210&
    ExifSubjectLoc = 41492    '&HA214&
    ExifExposureIndex = 41493    '&HA215&
    ExifSensingMethod = 41495    '&HA217&
    ExifFileSource = 41728    '&HA300&
    ExifSceneType = 41729    '&HA301&
    ExifCfaPattern = 41730    '&HA302&
End Enum

'GDI - General
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Status
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Status
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal FileName As Long, ByRef Bitmap As Long) As Status
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Status
'GDI - Image / Properties
Private Declare Function GdipGetImageGraphicsContext Lib "gdiplus" (ByVal Image As Long, graphics As Long) As Status
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Status
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal Image As Long, ByVal FileName As Long, clsidEncoder As GUID, encoderParams As Any) As Status
Private Declare Function GdipGetImageDimension Lib "gdiplus" (ByVal Image As Long, Width As Single, Height As Single) As Status
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal Image As Long, Width As Long) As Status
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal Image As Long, Height As Long) As Status
'GDI - Text
'https://docs.microsoft.com/en-us/previous-versions//ms535991(v=vs.85)

Private Declare Function GdipCreateFontFamilyFromName Lib "gdiplus" (ByVal FontName As String, ByVal fontCollection As Long, fontFamily As Long) As Status
Private Declare Function GdipCreateFont Lib "gdiplus" (ByVal fontFamily As Long, ByVal emSize As Single, ByVal style As Integer, ByVal unit As Integer, font As Long) As Status
Private Declare Function GdipCreateStringFormat Lib "gdiplus" (ByVal formatAttributes As Long, ByVal language As Integer, StringFormat As Long) As Status
Private Declare Function GdipSetStringFormatAlign Lib "gdiplus" (ByVal StringFormat As Long, ByVal Align As StringAlignment) As Status
Private Declare Function GdipSetStringFormatLineAlign Lib "gdiplus" (ByVal StringFormat As Long, ByVal Align As StringAlignment) As Status
'Private Declare Function GdipSetStringFormatFlags Lib "GdiPlus.dll" (ByVal mFormat As Long, ByVal mFlags As StringFormatFlags) As Status
'Private Declare Function GdipSetStringFormatTrimming Lib "GdiPlus.dll" (ByVal mFormat As Long, ByVal mTrimming As StringTrimming) As Status
Private Declare Function GdipCreateSolidFill Lib "gdiplus" (ByVal color As Long, Brush As Long) As Status
Private Declare Function GdipDrawString Lib "gdiplus" (ByVal graphics As Long, ByVal str As String, ByVal Length As Long, ByVal thefont As Long, layoutRect As RECTF, ByVal StringFormat As Long, ByVal Brush As Long) As Status
Private Declare Function GdipMeasureString Lib "gdiplus" (ByVal graphics As Long, ByVal str As String, ByVal Length As Long, ByVal thefont As Long, layoutRect As RECTF, ByVal StringFormat As Long, boundingBox As RECTF, codepointsFitted As Long, LinesFilled As Long) As Long
Private Declare Function GdipDrawRectangle Lib "gdiplus" (ByVal graphics As Long, ByVal pen As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Status
Private Declare Function GdipCreatePen1 Lib "gdiplus" (ByVal color As Long, ByVal Width As Single, ByVal unit As Integer, pen As Long) As Status

Private Declare Function GdipDeleteBrush Lib "gdiplus" (ByVal Brush As Long) As Status
Private Declare Function GdipDeletePen Lib "gdiplus" (ByVal pen As Long) As Status
Private Declare Function GdipDeleteFontFamily Lib "gdiplus" (ByVal fontFamily As Long) As Status
Private Declare Function GdipDeleteFont Lib "gdiplus" (ByVal curFont As Long) As Status

'Helper API Declarations
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long

Dim lGDIpToken                As Long
Dim bGDIpInitialized          As Boolean
Dim lBitmap                   As Long
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------


Private Function GDIErrorToString(ByVal lGDIError As Status) As String
    Select Case lGDIError
        Case GenericError
            GDIErrorToString = "Generic Error."
        Case InvalidParameter
            GDIErrorToString = "Invalid Parameter."
        Case OutOfMemory
            GDIErrorToString = "Out Of Memory."
        Case ObjectBusy
            GDIErrorToString = "Object Busy."
        Case InsufficientBuffer
            GDIErrorToString = "Insufficient Buffer."
        Case NotImplemented
            GDIErrorToString = "Not Implemented."
        Case Win32Error
            GDIErrorToString = "Win32 Error."
        Case WrongState
            GDIErrorToString = "Wrong State."
        Case Aborted
            GDIErrorToString = "Aborted."
        Case FileNotFound
            GDIErrorToString = "File Not Found."
        Case ValueOverflow
            GDIErrorToString = "Value Overflow."
        Case AccessDenied
            GDIErrorToString = "Access Denied."
        Case UnknownImageFormat
            GDIErrorToString = "Unknown Image Format."
        Case FontFamilyNotFound
            GDIErrorToString = "FontFamily Not Found."
        Case FontStyleNotFound
            GDIErrorToString = "FontStyle Not Found."
        Case NotTrueTypeFont
            GDIErrorToString = "Not TrueType Font."
        Case UnsupportedGdiplusVersion
            GDIErrorToString = "Unsupported Gdiplus Version."
        Case GdiplusNotInitialized
            GDIErrorToString = "Gdiplus Not Initialized."
        Case PropertyNotFound
            GDIErrorToString = "Property Not Found."
        Case PropertyNotSupported
            GDIErrorToString = "Property Not Supported."
        Case Else
            GDIErrorToString = "Unknown Error."
    End Select
End Function


'---------------------------------------------------------------------------------------
' Procedure : AddTextToImage
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   :
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile     : Fully qualified path and filename of the image file to get info about
' sText     : Text to add to image
'
' Usage:
' ~~~~~~
' Call AddTextToImage("C:\Temp\IMG01 - Copy.jpg", "©CARDA Consultants Inc.")
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2022-01-08              Initial Blog Release
'---------------------------------------------------------------------------------------
Public Function AddTextToImage(ByVal sFile As String, ByVal sText As String) As Boolean
    On Error GoTo Error_Handler
    Dim GDIpStartupInput      As GDIPlusStartupInput
    Dim GDIStatus             As Status
    Dim tEncoder              As GUID
    Dim tParams               As EncoderParameters
    Dim sTmp                  As String
    Dim sExt                  As String
    Dim lPropertyItemSize     As Long
        Dim graphics          As Long
        Dim family            As Long
        Dim font              As Long
        Dim Brush             As Long
        Dim layout            As RECTF
        Dim lBitmapWidth      As Long
        Dim lBitmapHeight     As Long
        Dim box               As RECTF
        Dim points            As Long
        Dim LinesFilled       As Long
        Dim lFormat           As Long
        Const lBuffer         As Long = 10

    'Start GDI
    '-------------------------------------------------------------------------------------
    If bGDIpInitialized = False Then
        GDIpStartupInput.GdiPlusVersion = 1
        GDIStatus = GdiplusStartup(lGDIpToken, GDIpStartupInput, ByVal 0)
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to start the GDI+ API" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            GoTo Error_Handler_Exit
        Else
            bGDIpInitialized = True
        End If
    End If

    'Load our Image to work with
    '-------------------------------------------------------------------------------------
    'In case we already have something in memory let's dispose of it properly
    If lBitmap <> 0 Then
        GDIStatus = GdipDisposeImage(lBitmap)
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to dispose of the current image in memory" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            GoTo Error_Handler_Exit
        End If
    End If
    'Now let's proceed with loading the actual image we want to work with
    Kill sFile
    FileCopy "C:\Temp\IMG01.jpg", sFile
    GDIStatus = GdipCreateBitmapFromFile(StrPtr(sFile), lBitmap)
    If GDIStatus <> Status.OK Then
        MsgBox "Unable to load the specified image" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
        GoTo Error_Handler_Exit
    End If

    'Work with the image
    '-------------------------------------------------------------------------------------
    If lBitmap Then
        'Add Text
        GDIStatus = GdipGetImageGraphicsContext(lBitmap, graphics)
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to get the image's graphical context." & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            GoTo Error_Handler_Exit
        End If
        
        'Get the image dimensions
        GdipGetImageWidth lBitmap, lBitmapWidth
        GdipGetImageHeight lBitmap, lBitmapHeigh
        
        'Define the Font
        GdipCreateFontFamilyFromName StrConv("Arial", vbUnicode), 0, family
        GdipCreateFont family, 96, 0, 2, font    ' Regular=0 Bold=1 Italic=2 BoldItalic=3 Underline=4 Strikeout=8
                                                 ' World=0 Display=1 Pixel=2 Point=3 Inch=4 Document=5 Millimeter=6
        'Define the Font Formatting
        GdipCreateStringFormat 0, 0, lFormat
        GdipSetStringFormatAlign lFormat, StringAlignmentFar    'StringAlignmentNear = Left, StringAlignmentCenter = Center, StringAlignmentFar = Right
        'Define the Font Color (ARGB)
        GdipCreateSolidFill &HFF000000, Brush 'Black Writing
        'GdipCreateSolidFill &HFFFFFFFF, Brush    'White writing
        'GdipCreateSolidFill &HFFFF3300, brush 'Orange writing
        'GdipCreateSolidFill &HFF0000CC, brush 'Navy writing
        
        GdipMeasureString graphics, StrConv(sText, vbUnicode), Len(StrConv(sText, vbUnicode)), font, layout, lFormat, box, points, LinesFilled

        'Position the String in the Y-axis by changing the .Top value, X-axis is controlled by the StringFormatAlign (above)
        'Using +/- 10 as a buffer
        With layout
            .Left = 0    '****Do Not Change This Value! X-axis is controlled by the StringFormatAlign (above)
            '.Top = 0    'Vertical - Top
            '.Top = lBitmapHeight / 2 'Vertical - Middle
            .Top = lBitmapHeight - (box.Bottom - box.Top)  'Vertical - Bottom
            .Right = lBitmapWidth
            .Bottom = lBitmapHeight
        End With

        'GdipDrawString graphics, StrConv(sText, vbUnicode), -1, font, layout, 0&, brush    'No format applied
        GdipDrawString graphics, StrConv(sText, vbUnicode), -1, font, layout, lFormat, Brush    'No format applied

        'Save the changes
        '   Cannot save over the file itself, so create a tmp file, release the current one then copy the image over
        sExt = Mid(sFile, InStrRev(sFile, ".") + 1)
        Select Case sExt
            Case "bmp", "dib"
                CLSIDFromString StrPtr(ImageCodecBMP), tEncoder
            Case "gif"
                CLSIDFromString StrPtr(ImageCodecGIF), tEncoder
            Case "jpg", "jpeg", "jpe", "jfif"
                CLSIDFromString StrPtr(ImageCodecJPG), tEncoder

                With tParams
                    .Count = 1
                    .Parameter(0).NumberOfValues = 1
                    .Parameter(0).type = EncoderParameterValueTypeLong
                    .Parameter(0).Value = VarPtr(100)    '100% Quality
                    CLSIDFromString StrPtr(EncoderQuality), .Parameter(0).GUID
                End With
            Case "png"
                CLSIDFromString StrPtr(ImageCodecPNG), tEncoder
            Case "tif", "tiff"
                CLSIDFromString StrPtr(ImageCodecTIF), tEncoder

                With tParams
                    .Count = 1
                    .Parameter(0).NumberOfValues = 1
                    .Parameter(0).type = EncoderParameterValueTypeLong
                    .Parameter(0).Value = VarPtr(TiffCompressionNone)
                    CLSIDFromString StrPtr(EncoderCompression), .Parameter(0).GUID
                End With
            Case Else
                Exit Function
        End Select

        sTmp = Environ("Temp") & "\TempSave." & sExt
        GDIStatus = GdipSaveImageToFile(lBitmap, StrPtr(sTmp), tEncoder, ByVal tParams)
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to save the image" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            Exit Function
        End If
    End If

Error_Handler_Exit:
    On Error Resume Next
    'Shutdown GDI
    '-------------------------------------------------------------------------------------
    If bGDIpInitialized = True Then
        If lBitmap <> 0 Then
            GDIStatus = GdipDeleteBrush(Brush)
            GDIStatus = GdipDeleteFont(font)
            GDIStatus = GdipDeleteFontFamily(family)
            GDIStatus = GdipDeleteGraphics(graphics)
            If GDIStatus <> Status.OK Then
                MsgBox "Unable to the image graphics." & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
                Exit Function
            End If
            'Release the current file
            GDIStatus = GdipDisposeImage(lBitmap)
            If GDIStatus <> Status.OK Then
                MsgBox "Unable to dispose of the processed image." & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
                Exit Function
            Else
                lBitmap = 0
                'Overwrite the file with our Temp File and Cleanup
                If sTmp <> "" Then
                    Call FileCopy(sTmp, sFile)
                    If Len(Dir(sFile)) > 0 Then
                        AddTextToImage = True
                        Kill sTmp
                        FollowHyperlink sFile
                    End If
                End If
            End If
        End If
        GDIStatus = GdiplusShutdown(lGDIpToken)
        If GDIStatus <> Status.OK Then
            MsgBox "Unable to shutdown the GDI+ API." & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
            Exit Function
        Else
            bGDIpInitialized = False
        End If
    End If
    Exit Function

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: AddTextToImage" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

and now you can add a textual watermark to an image with a single line of code, such as

Call AddTextToImage("C:\Temp\IMG01 - Copy.jpg", "©CARDA Consultants Inc.")

A Few Comments About the Code

Font

You can set the font family by editing the value Arial in the line

GdipCreateFontFamilyFromName StrConv("Arial", vbUnicode), 0, family

Font Size

You can set the font size by editing the value 96 in the line

GdipCreateFont family, 96, 0, 2, font

Font Color

You can set the font color by editing the value &HFF000000 in the line

GdipCreateSolidFill &HFF000000, Brush 'Black Writing

Watermark Positioning

Horizontal Alignment

You can control the horizontal alignment by editing the value StringAlignmentFar in the line

GdipSetStringFormatAlign lFormat, StringAlignmentFar

You can use:
StringAlignmentNear ‘Left Align
StringAlignmentCenter ‘Center
StringAlignmentFar ‘Right Align

Vertical Alignment

You can specify the vertical alignment by editing the .Top value in the following block of code

        With layout
            .Left = 0    '****Do Not Change This Value! X-axis is controlled by the StringFormatAlign (above)
            '.Top = 0    'Vertical - Top
            '.Top = lBitmapHeight / 2 'Vertical - Middle
            .Top = lBitmapHeight - (box.Bottom - box.Top)  'Vertical - Bottom
            .Right = lBitmapWidth
            .Bottom = lBitmapHeight
        End With

You can set the value to anything you wish that doesn’t exceed the lBitmapHeight value (or else it will fall outside the bounds of the image), but below are the 3 value I thought could be most useful:
.Top = 0 ‘Top Align
.Top = lBitmapHeight / 2 ‘Middle Align
.Top = lBitmapHeight – (box.Bottom – box.Top) ‘Bottom Align

A Final Word

I found VBA documentation to be very scarce and poor. Microsoft truly couldn’t do a poorer job! When searching I kept coming up against dead links because Microsoft has removed many resources that used to exist. The only resources I could find most of the time were for C++. So, if you decided to further explorer GDI+ do arm yourself with lots of patience as it takes a bit of time to get used to the way it works. I also found one API misbehaving and have been unable to get anyone able to help/explain why, so there may be some issues.

Well this ends my exploration of the GDI+ API(s) (for now, I may dabble again at a later date) and I truly hope this helps a few of you out there.

A Few Resources on the Subject

2 responses on “Adding a Watermark to an Image Using The GDI+ API

  1. Jason Lee Hayes

    I’m unable to get this to work unfortunately..
    Firstly, i assume there is a typo or copy/paste error in the line below specifically “lBitmapHeig”

    ‘Get the image dimensions
    GdipGetImageWidth lBitmap, lBitmapWidth
    GdipGetImageHeight lBitmap, lBitmapHeigh

    I have changed this to:-
    ‘Get the image dimensions
    GdipGetImageWidth lBitmap, lBitmapWidth
    GdipGetImageHeight lBitmap, lBitmapHeight

    All good in compiling after change however when calling function i get the message “file not found”?
    I have crated a JPEG file using the exact same name and is stored in same Temp folder.
    After calling using the following:-
    Call AddTextToImage(“C:\Temp\IMG01 – Copy.jpg”, “©CARDA Consultants Inc.”)

    I receive an error stating file not found?
    On checking Temp folder content the file is deleted (So the Kill function is working) but i dont see a new file with the watermark in…

    This function is something i could definitely use so any help would be appreciated.. I will keep investigating what the issue may be but i’m confident the path/filename and file type are correct…

  2. Jason Lee Hayes

    Hi,
    All sorted….
    I got confused, i didn’t realise :-
    Call AddTextToImage(“C:\Temp\IMG01 – Copy.jpg”, “©CARDA Consultants Inc.”)
    This represents the file path and image name to be created after watermarking NOT the source file Path & Image Name.

    Excellent – Thankyou