This is my 5th article exploring how we can use the GDI+ API(s) within VBA to work with image files and their properties. Below are my previous articles:
Getting a Specific Image Property Using The GDI+ API
I thought I’d look at another approach to retrieving information about images. Previously, I demonstrated how one can get file properties (including images) by using plain VBA or PowerShell: Today, however, I thought I’d demonstrate using the GDI Plus API. This will be Part 1 in a series of posts on the GDI Plus…
Getting All of an Image's Properties Using The GDI+ API
Continuing on my multipart series on using the GDI+ APIs, after looking at how we can retrieve a single property as discussed in my previous article I thought I’d explore retrieving all of the available properties.
Deleting an Image's Property Using The GDI+ API
Up until now, in my 2 prior articles, we seen how we can read a single property or get all an images properties: Today, I’m going to start showing you the real power of GDI+, we are going to examine deleting an image’s property. The Code The entire process revolves around the GdipRemovePropertyItem function. That…
Deleting All an Image’s Properties Using The GDI+ API
This is another post in a series of posts relating to using the GDI+ API to work with images. You can refer to my earlier articles: Today, I thought, like I did for retrieving properties, I’d show you how you can delete all of an image’s properties in one shot. This can be useful when…
Today, we will explore how we can create, or set, a property!
The Code
The concept here is pretty straightforward (the code not so much!) we simply need to use the GdipSetPropertyItem function to, you guessed it, set the property with a value. Then issue here is that we have to pass the type of property, convert the value into the proper format and finally build a PropertyItem that we pass to the function. Thus, we need to create a few helper functions.
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 PropertyItem
id As Long 'PropertyTagId
Length As Long
type As Integer 'PropertyTagType
Value As Long
End Type
'GDI+ Status Constants
Private 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
'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
Public Enum PropertyTagType
'https://docs.microsoft.com/en-us/windows/win32/gdiplus/-gdiplus-constant-image-property-tag-type-constants
TypeByte = 1
TypeASCII = 2
TypeShort = 3
TypeLong = 4
TypeRational = 5
TypeUndefined = 7
TypeSLong = 9
TypeSRational = 10
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 GdipGetAllPropertyItems Lib "gdiplus" (ByVal Image As Long, ByVal totalBufferSize As Long, ByVal numProperties As Long, ByRef allItems As PropertyItem) As Status
Private Declare Function GdipGetPropertySize Lib "gdiplus" (ByVal Image As Long, ByRef totalBufferSize As Long, ByRef numProperties 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 GdipSetPropertyItem Lib "gdiplus" (ByVal Image As Long, ByRef item As Long) As Status
'Helper API Declarations
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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
Function GetPropertyType(lPropertyTagId As PropertyTagId) As PropertyTagType
'https://docs.microsoft.com/en-us/windows/win32/gdiplus/-gdiplus-constant-property-item-descriptions
Select Case lPropertyTagId
Case PropertyTagId.GpsVer: GetPropertyType = TypeByte
Case PropertyTagId.GpsLatitudeRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsLatitude: GetPropertyType = TypeRational
Case PropertyTagId.GpsLongitudeRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsLongitude: GetPropertyType = TypeRational
Case PropertyTagId.GpsAltitudeRef: GetPropertyType = TypeByte
Case PropertyTagId.GpsAltitude: GetPropertyType = TypeRational
Case PropertyTagId.GpsGpsTime: GetPropertyType = TypeRational
Case PropertyTagId.GpsGpsSatellites: GetPropertyType = TypeASCII
Case PropertyTagId.GpsGpsStatus: GetPropertyType = TypeASCII
Case PropertyTagId.GpsGpsMeasureMode: GetPropertyType = TypeASCII
Case PropertyTagId.GpsGpsDop: GetPropertyType = TypeRational
Case PropertyTagId.GpsSpeedRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsSpeed: GetPropertyType = TypeRational
Case PropertyTagId.GpsTrackRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsTrack: GetPropertyType = TypeRational
Case PropertyTagId.GpsImgDirRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsImgDir: GetPropertyType = TypeRational
Case PropertyTagId.GpsMapDatum: GetPropertyType = TypeASCII
Case PropertyTagId.GpsDestLatRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsDestLat: GetPropertyType = TypeRational
Case PropertyTagId.GpsDestLongRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsDestLong: GetPropertyType = TypeRational
Case PropertyTagId.GpsDestBearRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsDestBear: GetPropertyType = TypeRational
Case PropertyTagId.GpsDestDistRef: GetPropertyType = TypeASCII
Case PropertyTagId.GpsDestDist: GetPropertyType = TypeRational
Case PropertyTagId.NewSubfileType: GetPropertyType = TypeLong
Case PropertyTagId.SubfileType: GetPropertyType = TypeShort
Case PropertyTagId.ImageWidth: GetPropertyType = TypeLong 'Short or Long?
Case PropertyTagId.ImageHeight: GetPropertyType = TypeLong
Case PropertyTagId.BitsPerSample: GetPropertyType = TypeShort
Case PropertyTagId.Compression: GetPropertyType = TypeShort
Case PropertyTagId.PhotometricInterp: GetPropertyType = TypeShort
Case PropertyTagId.ThreshHolding: GetPropertyType = TypeShort
Case PropertyTagId.CellWidth: GetPropertyType = TypeShort
Case PropertyTagId.CellHeight: GetPropertyType = TypeShort
Case PropertyTagId.FillOrder: GetPropertyType = TypeShort
Case PropertyTagId.DocumentName: GetPropertyType = TypeASCII
Case PropertyTagId.ImageDescription: GetPropertyType = TypeASCII
Case PropertyTagId.EquipMake: GetPropertyType = TypeASCII
Case PropertyTagId.EquipModel: GetPropertyType = TypeASCII
Case PropertyTagId.StripOffsets: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.Orientation: GetPropertyType = TypeShort
Case PropertyTagId.SamplesPerPixel: GetPropertyType = TypeShort
Case PropertyTagId.RowsPerStrip: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.StripBytesCount: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.MinSampleValue: GetPropertyType = TypeShort
Case PropertyTagId.MaxSampleValue: GetPropertyType = TypeShort
Case PropertyTagId.XResolution: GetPropertyType = TypeRational
Case PropertyTagId.YResolution: GetPropertyType = TypeRational
Case PropertyTagId.PlanarConfig: GetPropertyType = TypeShort
Case PropertyTagId.PageName: GetPropertyType = TypeASCII
Case PropertyTagId.XPosition: GetPropertyType = TypeRational
Case PropertyTagId.YPosition: GetPropertyType = TypeRational
Case PropertyTagId.FreeOffset: GetPropertyType = TypeLong
Case PropertyTagId.FreeByteCounts: GetPropertyType = TypeLong
Case PropertyTagId.GrayResponseUnit: GetPropertyType = TypeShort
Case PropertyTagId.GrayResponseCurve: GetPropertyType = TypeShort
Case PropertyTagId.T4Option: GetPropertyType = TypeLong
Case PropertyTagId.T6Option: GetPropertyType = TypeLong
Case PropertyTagId.ResolutionUnit: GetPropertyType = TypeShort
Case PropertyTagId.PageNumber: GetPropertyType = TypeShort
Case PropertyTagId.TransferFunction: GetPropertyType = TypeShort
Case PropertyTagId.SoftwareUsed: GetPropertyType = TypeASCII
Case PropertyTagId.DateTime: GetPropertyType = TypeASCII
Case PropertyTagId.Artist: GetPropertyType = TypeASCII
Case PropertyTagId.HostComputer: GetPropertyType = TypeASCII
Case PropertyTagId.Predictor: GetPropertyType = TypeShort
Case PropertyTagId.WhitePoint: GetPropertyType = TypeRational
Case PropertyTagId.PrimaryChromaticities: GetPropertyType = TypeRational
Case PropertyTagId.ColorMap: GetPropertyType = TypeShort
Case PropertyTagId.HalftoneHints: GetPropertyType = TypeShort
Case PropertyTagId.TileWidth: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.TileLength: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.TileOffset: GetPropertyType = TypeLong
Case PropertyTagId.TileByteCounts: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.InkSet: GetPropertyType = TypeShort
Case PropertyTagId.InkNames: GetPropertyType = TypeASCII
Case PropertyTagId.NumberOfInks: GetPropertyType = TypeShort
Case PropertyTagId.DotRange: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.TargetPrinter: GetPropertyType = TypeASCII
Case PropertyTagId.ExtraSamples: GetPropertyType = TypeShort
Case PropertyTagId.SampleFormat: GetPropertyType = TypeShort
Case PropertyTagId.TransferRange: GetPropertyType = TypeShort
Case PropertyTagId.JPEGProc: GetPropertyType = TypeShort
Case PropertyTagId.JPEGInterFormat: GetPropertyType = TypeLong
Case PropertyTagId.JPEGInterLength: GetPropertyType = TypeLong
Case PropertyTagId.JPEGRestartInterval: GetPropertyType = TypeShort
Case PropertyTagId.JPEGLosslessPredictors: GetPropertyType = TypeShort
Case PropertyTagId.JPEGPointTransforms: GetPropertyType = TypeShort
Case PropertyTagId.JPEGQTables: GetPropertyType = TypeLong
Case PropertyTagId.JPEGDCTables: GetPropertyType = TypeLong
Case PropertyTagId.JPEGACTables: GetPropertyType = TypeLong
Case PropertyTagId.YCbCrCoefficients: GetPropertyType = TypeRational
Case PropertyTagId.YCbCrSubsampling: GetPropertyType = TypeShort
Case PropertyTagId.YCbCrPositioning: GetPropertyType = TypeShort
Case PropertyTagId.REFBlackWhite: GetPropertyType = TypeRational
Case PropertyTagId.Gamma: GetPropertyType = TypeRational
Case PropertyTagId.ICCProfileDescriptor: GetPropertyType = TypeASCII
Case PropertyTagId.SRGBRenderingIntent: GetPropertyType = TypeByte
Case PropertyTagId.ImageTitle: GetPropertyType = TypeASCII
Case PropertyTagId.ResolutionXUnit: GetPropertyType = TypeShort
Case PropertyTagId.ResolutionYUnit: GetPropertyType = TypeShort
Case PropertyTagId.ResolutionXLengthUnit: GetPropertyType = TypeShort
Case PropertyTagId.ResolutionYLengthUnit: GetPropertyType = TypeShort
Case PropertyTagId.PrintFlags: GetPropertyType = TypeASCII
Case PropertyTagId.PrintFlagsVersion: GetPropertyType = TypeShort
Case PropertyTagId.PrintFlagsCrop: GetPropertyType = TypeByte
Case PropertyTagId.PrintFlagsBleedWidth: GetPropertyType = TypeLong
Case PropertyTagId.PrintFlagsBleedWidthScale: GetPropertyType = TypeShort
Case PropertyTagId.HalftoneLPI: GetPropertyType = TypeRational
Case PropertyTagId.HalftoneLPIUnit: GetPropertyType = TypeShort
Case PropertyTagId.HalftoneDegree: GetPropertyType = TypeRational
Case PropertyTagId.HalftoneShape: GetPropertyType = TypeShort
Case PropertyTagId.HalftoneMisc: GetPropertyType = TypeLong
Case PropertyTagId.HalftoneScreen: GetPropertyType = TypeByte
Case PropertyTagId.JPEGQuality: GetPropertyType = TypeShort
Case PropertyTagId.GridSize: GetPropertyType = TypeUndefined
Case PropertyTagId.ThumbnailFormat: GetPropertyType = TypeLong
Case PropertyTagId.ThumbnailWidth: GetPropertyType = TypeLong
Case PropertyTagId.ThumbnailHeight: GetPropertyType = TypeLong
Case PropertyTagId.ThumbnailColorDepth: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailPlanes: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailRawBytes: GetPropertyType = TypeLong
Case PropertyTagId.ThumbnailSize: GetPropertyType = TypeLong
Case PropertyTagId.ThumbnailCompressedSize: GetPropertyType = TypeLong
Case PropertyTagId.ColorTransferFunction: GetPropertyType = TypeUndefined
Case PropertyTagId.ThumbnailData: GetPropertyType = TypeByte
Case PropertyTagId.ThumbnailImageWidth: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.ThumbnailImageHeight: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.ThumbnailBitsPerSample: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailCompression: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailPhotometricInterp: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailImageDescription: GetPropertyType = TypeASCII
Case PropertyTagId.ThumbnailEquipMake: GetPropertyType = TypeASCII
Case PropertyTagId.ThumbnailEquipModel: GetPropertyType = TypeASCII
Case PropertyTagId.ThumbnailStripOffsets: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.ThumbnailOrientation: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailSamplesPerPixel: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailRowsPerStrip: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.ThumbnailStripBytesCount: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.ThumbnailResolutionX: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailResolutionY: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailPlanarConfig: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailResolutionUnit: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailTransferFunction: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailSoftwareUsed: GetPropertyType = TypeASCII
Case PropertyTagId.ThumbnailDateTime: GetPropertyType = TypeASCII
Case PropertyTagId.ThumbnailArtist: GetPropertyType = TypeASCII
Case PropertyTagId.ThumbnailWhitePoint: GetPropertyType = TypeRational
Case PropertyTagId.ThumbnailPrimaryChromaticities: GetPropertyType = TypeRational
Case PropertyTagId.ThumbnailYCbCrCoefficients: GetPropertyType = TypeRational
Case PropertyTagId.ThumbnailYCbCrSubsampling: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailYCbCrPositioning: GetPropertyType = TypeShort
Case PropertyTagId.ThumbnailRefBlackWhite: GetPropertyType = TypeRational
Case PropertyTagId.ThumbnailCopyRight: GetPropertyType = TypeASCII
Case PropertyTagId.LuminanceTable: GetPropertyType = TypeShort
Case PropertyTagId.ChrominanceTable: GetPropertyType = TypeShort
Case PropertyTagId.FrameDelay: GetPropertyType = TypeLong
Case PropertyTagId.LoopCount: GetPropertyType = TypeShort
Case PropertyTagId.GlobalPalette: GetPropertyType = TypeByte
Case PropertyTagId.IndexBackground: GetPropertyType = TypeByte
Case PropertyTagId.IndexTransparent: GetPropertyType = TypeByte
Case PropertyTagId.PixelUnit: GetPropertyType = TypeByte
Case PropertyTagId.PixelPerUnitX: GetPropertyType = TypeLong
Case PropertyTagId.PixelPerUnitY: GetPropertyType = TypeLong
Case PropertyTagId.PaletteHistogram: GetPropertyType = TypeByte
Case PropertyTagId.Copyright: GetPropertyType = TypeASCII
Case PropertyTagId.ExifExposureTime: GetPropertyType = TypeRational
Case PropertyTagId.ExifFNumber: GetPropertyType = TypeRational
Case PropertyTagId.ExifIFD: GetPropertyType = TypeLong
Case PropertyTagId.ICCProfile: GetPropertyType = TypeByte
Case PropertyTagId.ExifExposureProg: GetPropertyType = TypeShort
Case PropertyTagId.ExifSpectralSense: GetPropertyType = TypeASCII
Case PropertyTagId.GpsIFD: GetPropertyType = TypeLong
Case PropertyTagId.ExifISOSpeed: GetPropertyType = TypeShort
Case PropertyTagId.ExifOECF: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifVer: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifDTOrig: GetPropertyType = TypeASCII
Case PropertyTagId.ExifDTDigitized: GetPropertyType = TypeASCII
Case PropertyTagId.ExifCompConfig: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifCompBPP: GetPropertyType = TypeRational
Case PropertyTagId.ExifShutterSpeed: GetPropertyType = TypeSRational
Case PropertyTagId.ExifAperture: GetPropertyType = TypeRational
Case PropertyTagId.ExifBrightness: GetPropertyType = TypeSRational
Case PropertyTagId.ExifExposureBias: GetPropertyType = TypeSRational
Case PropertyTagId.ExifMaxAperture: GetPropertyType = GetPropertyType
Case PropertyTagId.ExifSubjectDist: GetPropertyType = TypeRational
Case PropertyTagId.ExifMeteringMode: GetPropertyType = TypeShort
Case PropertyTagId.ExifLightSource: GetPropertyType = TypeShort
Case PropertyTagId.ExifFlash: GetPropertyType = TypeShort
Case PropertyTagId.ExifFocalLength: GetPropertyType = TypeRational
Case PropertyTagId.ExifMakerNote: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifUserComment: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifDTSubsec: GetPropertyType = TypeASCII
Case PropertyTagId.ExifDTOrigSS: GetPropertyType = TypeASCII
Case PropertyTagId.ExifDTDigSS: GetPropertyType = TypeASCII
Case PropertyTagId.ExifFPXVer: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifColorSpace: GetPropertyType = TypeShort
Case PropertyTagId.ExifPixXDim: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.ExifPixYDim: GetPropertyType = TypeLong 'Short or Long
Case PropertyTagId.ExifRelatedWav: GetPropertyType = TypeASCII
Case PropertyTagId.ExifInterop: GetPropertyType = TypeLong
Case PropertyTagId.ExifFlashEnergy: GetPropertyType = TypeRational
Case PropertyTagId.ExifSpatialFR: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifFocalXRes: GetPropertyType = TypeRational
Case PropertyTagId.ExifFocalYRes: GetPropertyType = TypeRational
Case PropertyTagId.ExifFocalResUnit: GetPropertyType = TypeShort
Case PropertyTagId.ExifSubjectLoc: GetPropertyType = TypeShort
Case PropertyTagId.ExifExposureIndex: GetPropertyType = TypeRational
Case PropertyTagId.ExifSensingMethod: GetPropertyType = TypeShort
Case PropertyTagId.ExifFileSource: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifSceneType: GetPropertyType = TypeUndefined
Case PropertyTagId.ExifCfaPattern: GetPropertyType = TypeUndefined
Case Else: GetPropertyType = TypeUndefined
End Select
End Function
'---------------------------------------------------------------------------------------
' Procedure : SetImageProperty
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Set the image property with the specified value
' 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
' lPropertyTagId : Property to the set the value of
' vPropertyValue : Value to set for the property. In the case of Rational / Nominator value
' vPropertyValue2 : Rational only / Denominator value
'
' Usage:
' ~~~~~~
' ? SetImageProperty("C:\Temp\IMG01 - Copy.jpg", EquipModel , "Huawei")
' Returns -> True/False
' ? SetImageProperty("C:\Temp\IMG01 - Copy.jpg", ImageWidth , 179306496)
' Returns -> True/False
' ? SetImageProperty("C:\Temp\IMG01 - Copy.jpg", ExifISOSpeed , 250)
' Returns -> True/False
' ? SetImageProperty("C:\Temp\IMG01 - Copy.jpg", ImageDescription , "View from the house")
' Returns -> True/False
' ? SetImageProperty("C:\Temp\IMG01 - Copy.jpg",ExifFNumber , 180, 100)
' Returns -> True/False
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2022-01-09 Initial Blog Release
'---------------------------------------------------------------------------------------
Public Function SetImageProperty(ByVal sFile As String, ByVal lPropertyTagId As PropertyTagId, ByVal vPropertyValue As Variant, Optional ByVal vPropertyValue2 As Variant) As Boolean
On Error GoTo Error_Handler
Dim GDIpStartupInput As GDIPlusStartupInput
Dim GDIStatus As Status
Dim PI As PropertyItem
Dim byteValue As Byte
Dim sValue As String
Dim lValue As Long
Dim iValue As Integer
Dim lPropertyType As PropertyTagType
Dim tEncoder As GUID
Dim tParams As EncoderParameters
Dim sTmp As String
Dim sExt As String
'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
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
'-------------------------------------------------------------------------------------
'Get Property Type
lPropertyType = GetPropertyType(lPropertyTagId)
PI.id = lPropertyTagId
PI.type = lPropertyType
Select Case lPropertyType
Case PropertyTagType.TypeByte '1
byteValue = vPropertyValue
PI.Length = LenB(byteValue)
PI.Value = VarPtr(byteValue)
Case PropertyTagType.TypeASCII '2
sValue = vPropertyValue & vbNullChar
PI.Length = Len(sValue)
PI.Value = StrPtr(StrConv(sValue, vbFromUnicode))
Case PropertyTagType.TypeShort '3
iValue = vPropertyValue
PI.Length = LenB(iValue)
PI.Value = VarPtr(iValue)
Case PropertyTagType.TypeLong, PropertyTagType.TypeSLong '4, 9
Select Case lPropertyType
Case PropertyTagType.TypeLong
lValue = Abs(vPropertyValue)
Case PropertyTagType.TypeSLong
lValue = vPropertyValue
End Select
PI.Length = LenB(lValue)
PI.Value = VarPtr(lValue)
Case PropertyTagType.TypeRational, PropertyTagType.TypeSRational '5, 10
Dim dValue As Double
Dim bytProperty() As Byte
Dim DataSize As Long
Dim lNumerator As Long
Dim lDenominator As Long
Select Case lPropertyType
Case PropertyTagType.TypeRational
lNumerator = Abs(vPropertyValue)
lDenominator = Abs(vPropertyValue2)
Case PropertyTagType.TypeSRational
lNumerator = vPropertyValue
lDenominator = vPropertyValue2
End Select
DataSize = LenB(dValue)
ReDim bytProperty(DataSize - 1)
Call CopyMemory(bytProperty(0), lNumerator, DataSize / 2)
Call CopyMemory(bytProperty(0 + (DataSize / 2)), lDenominator, DataSize / 2)
Call CopyMemory(dValue, bytProperty(0), DataSize)
Erase bytProperty
PI.Length = DataSize '8
PI.Value = VarPtr(dValue)
Case Else 'PropertyTagType.TypeUndefined '7
Exit Function
End Select
GDIStatus = GdipSetPropertyItem(lBitmap, ByVal VarPtr(PI))
If GDIStatus <> Status.OK Then
MsgBox "Unable to set the specified property" & vbCrLf & vbCrLf & GDIErrorToString(GDIStatus), vbCritical Or vbOKOnly, "Operation Aborted"
GoTo Error_Handler_Exit
Else
'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 = 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
SetImageProperty = True
Kill sTmp
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: GetImageProperty" & 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
Now, with a single line of code we can set a property! For example, as indicated in the function header, we can do things like:
? SetImageProperty("C:\Temp\IMG01 - Copy.jpg", EquipModel , "Huawei")
? SetImageProperty("C:\Temp\IMG01 - Copy.jpg", ExifISOSpeed , 250)
? SetImageProperty("C:\Temp\IMG01 - Copy.jpg", ImageDescription , "View from the house")
? SetImageProperty("C:\Temp\IMG01 - Copy.jpg",ExifFNumber , 180, 100)
and so on.
For the sake of full disclosure, I have not tested that it works with every tag. I have tested with a bunch that I am interested in being able to work with:
- ImageWidth
- ImageHeight
- ImageDescription
- EquipMake
- EquipModel
- DateTime
- ImageTitle
- ThumbnailCopyRight
- …
Stay tuned, I have one more article on the subject of GDI+.
A Few Resources on the Subject
Status (gdiplustypes.h) - Win32 apps
The Status enumeration indicates the result of a Windows GDI+ method call.
Image Property Tag Type Constants (Gdiplusimaging.h) - Win32 apps
You can store and retrieve image metadata with the help of a PropertyItem object. The type data member of a PropertyItem object specifies the data type of the values stored in the value data member of that same PropertyItem object.
Property Tags in Numerical Order - Win32 apps
The following table lists the Windows GDI+ image property tags in numerical order.