VFP 6 - Getting at hidden picture information 10

eric43 · Jan 8, 2006

If you right click an image in Explorer and go to 'Properties' there are 3 tabs. If you are lucky the summary tag screen will contain a mess of details about the image - obviously stored by the camera.

Is there a way to access this information on an image file via VFP?

Thanks

Eric

Neil Toulouse · Jan 24, 2006

I get the same error as Eric, same DLL version (5.1.3102.2180). VFP6 on XP pro.

I like work. It fascinates me. I can sit and look at it for hours...

craigsboyd · Jan 24, 2006

Thanks eric43 and FatSlug. OK, when the a2u function returns, is it returning a Unicode string? What you should see is a string that looks like it has little boxes in-between each of the letters.

SweetPotato Software Website
My Blog

eric43 · Jan 24, 2006

Craig,

Relieved its not only my problem.

lcBuffer in a2u is a 'spaced out' filename - I guess this is unicode - but no little boxes shown.

'O F F I C E . J P G ' FOR EXAMPLE

Eric

Neil Toulouse · Jan 24, 2006

...and I get the same as Eric. No boxes but a spaced out filename.

I like work. It fascinates me. I can sit and look at it for hours...

Olaf Doschke · Jan 25, 2006

Hi Craig, Neil, Eric,

Try this as a replacement of a2u():

Code:

	PROTECTED Function a2u(tcStr)
#if Version(5) >= 700
		Return Strconv(tcStr + Chr(0), 5)
#else
		Local lnLen, lcWideStr
		lnLen = 2 * (Len(tcStr) + 1)
		lcWideStr = Replicate(Chr(0), lnLen)
		MultiByteToWideChar(0, 0, @tcStr, Len(tcStr), @lcWideStr, lnLen)
		Return lcWideStr
#endif
	ENDFUNC

I think it's important to initialise the Unicodestring-Buffer with chr(0).

Bye, Olaf.

Olaf Doschke · Jan 25, 2006

Hi again,

please remove the PROTECTED keyword. this function was stolen fram a class...

Bye, Olaf.

Neil Toulouse · Jan 25, 2006

Hi Olaf!

On my system it still has the same problem, spaced out return value and the same DLL error message.

Neil

I like work. It fascinates me. I can sit and look at it for hours...

Olaf Doschke · Jan 25, 2006

Hi all,

I found it: There is no GdiplusStartup (and Shutdown).

You need these 2 declares:

Code:

Declare Long GdiplusStartup in GdiPlus.dll ;
        Long @ token, String @ input, Long @ output

Declare Long GdiplusShutdown in GdiPlus.dll ;
        Long token

The class needs a gdiplusToken property and then use the Startup/Shutdown API calls this way:

Code:

    PROCEDURE GdipStartup()
    
  		Local gdiplusStartupInput, lcToken
	*	struct GdiplusStartupInput
	*	{
	*		UINT32 GdiplusVersion;				// Must be 1
	*		DebugEventProc DebugEventCallback;	// Ignored on free builds
	*		BOOL SuppressBackgroundThread;		// FALSE unless you're prepared to call 
	*											// the hook/unhook functions properly
	*		BOOL SuppressExternalCodecs;		// FALSE unless you want GDI+ only to use
	*											// its internal image codecs.
	*	}
		gdiplusStartupInput = Chr(1) + Replicate(Chr(0), 15)	&& GdiplusStartupInput structure (sizeof = 16)

		* Initialize GDI+.
		lcToken = 0
		If GdiplusStartup(@lcToken, @gdiplusStartupInput, 0) != 0
			Return .F.
		EndIf
		This.gdiplusToken = lcToken

    ENDPROC 
    
    PROCEDURE GdipShutdown()    
       GdiplusShutdown(This.gdiplusToken)
    ENDPROC

You can call GdipStartup() from class Init() and GdipShutdown() from Destroy.

The next call causing a problem for me is GdipGetPropertyCount. I haven't found out the reason yet.

Bye, Olaf.

Olaf Doschke · Jan 25, 2006

Hi all,

It works (in VFP7). I just needed to restart.

Here are the last changes:

Code:

*************************
    PROCEDURE fillpropertygrid
*************************
        WITH THIS
            .createpropertycursor()
            .getimageproperties()
            .grid1.RECORDSOURCE = "crsEXIF"
            .grid1.REFRESH()
            * .grid1.AUTOFIT()
        ENDWITH
    ENDPROC

*************************
    PROCEDURE INIT
*************************
        LOCAL lcImageFile
        lcImageFile = GETPICT()
        IF EMPTY(lcImageFile)
           RETURN .F.
        ENDIF
        THIS.DeclareAPIs()
        IF This.GdipStartup()
           THIS.gpImageHandle = THIS.GGetImageHandle(lcImageFile)
           THIS.fillpropertygrid()
        ELSE
           RETURN .F.
        ENDIF 
    ENDPROC

*************************
    PROCEDURE DESTROY
*************************
        This.GdipShutdown()
        USE IN SELECT("crsProps")
        USE IN SELECT("crsEXIF")
    ENDPROC

And don't forget the token property:

Code:

DEFINE CLASS form1 AS FORM

    gdiplusToken = ''
    TOP = 0
    LEFT = 17
* ...

Bye, Olaf.

Neil Toulouse · Jan 25, 2006

Hi Olaf!

Seems like Eric has given up with this! Anyway, I have made the changes specified, and I no longer get the error, BUT nothing is appearing in the grid.

Just in case I have done something wrong, could you post the complete code please!

Neil

I like work. It fascinates me. I can sit and look at it for hours...

Olaf Doschke · Jan 25, 2006

Hi Neil,

I think everything's fine with the code. Only there are little Exif informations. I also get no records for the foxpro BMPs in the graphics folder. Download the upper left picture on

http://www.universalthread.com

(called top1.jpg), there many Exif properties are included.

Nevertheless, here my completed prg:

Code:

PUBLIC oform1

oform1=NEWOBJECT("form1")
oform1.SHOW
RETURN

DEFINE CLASS form1 AS FORM

    gdiplusToken = ''
    TOP = 0
    LEFT = 17
    HEIGHT = 350
    WIDTH = 400
    DOCREATE = .T.
    CAPTION = "Get Image Properties (EXIF)"
    NAME = "Form1"
    gpImageHandle = 0
    

    ADD OBJECT grid1 AS GRID WITH ;
        ANCHOR = 14, ;
        HEIGHT = 351, ;
        LEFT = 0, ;
        TOP = 0, ;
        WIDTH = 400, ;
        NAME = "Grid1"

*************************
    PROCEDURE createpropertycursor
*************************
        CREATE CURSOR crsProps (PropName C(50), IDValue I)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsVer", 0x0000)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsLatitudeRef", 0x0001)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsLatitude", 0x0002)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsLongitudeRef", 0x0003)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsLongitude", 0x0004)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsAltitudeRef", 0x0005)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsAltitude", 0x0006)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsTime", 0x0007)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsSatellites", 0x0008)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsStatus", 0x0009)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsMeasureMode", 0x000A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsDop", 0x000B)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsSpeedRef", 0x000C)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsSpeed", 0x000D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsTrackRef", 0x000E)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsTrack", 0x000F)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsImgDirRef", 0x0010)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsImgDir", 0x0011)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsMapDatum", 0x0012)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestLatRef", 0x0013)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestLat", 0x0014)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestLongRef", 0x0015)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestLong", 0x0016)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestBearRef", 0x0017)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestBear", 0x0018)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestDistRef", 0x0019)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestDist", 0x001A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagNewSubfileType", 0x00FE)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSubfileType", 0x00FF)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagImageWidth", 0x0100)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagImageHeight", 0x0101)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagBitsPerSample", 0x0102)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagCompression", 0x0103)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPhotometricInterp", 0x0106)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThreshHolding", 0x0107)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagCellWidth", 0x0108)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagCellHeight", 0x0109)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagFillOrder", 0x010A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagDocumentName", 0x010D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagImageDescription", 0x010E)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagEquipMake", 0x010F)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagEquipModel", 0x0110)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagStripOffsets", 0x0111)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagOrientation", 0x0112)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSamplesPerPixel", 0x0115)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagRowsPerStrip", 0x0116)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagStripBytesCount", 0x0117)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagMinSampleValue", 0x0118)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagMaxSampleValue", 0x0119)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagXResolution", 0x011A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYResolution", 0x011B)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPlanarConfig", 0x011C)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPageName", 0x011D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagXPosition", 0x011E)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYPosition", 0x011F)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagFreeOffset", 0x0120)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagFreeByteCounts", 0x0121)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGrayResponseUnit", 0x0122)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGrayResponseCurve", 0x0123)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagT4Option", 0x0124)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagT6Option", 0x0125)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionUnit", 0x0128)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPageNumber", 0x0129)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTransferFunction", 0x012D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSoftwareUsed", 0x0131)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagDateTime", 0x0132)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagArtist", 0x013B)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHostComputer", 0x013C)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPredictor", 0x013D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagWhitePoint", 0x013E)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrimaryChromaticities", 0x013F)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagColorMap", 0x0140)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneHints", 0x0141)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTileWidth", 0x0142)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTileLength", 0x0143)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTileOffset", 0x0144)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTileByteCounts", 0x0145)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagInkSet", 0x014C)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagInkNames", 0x014D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagNumberOfInks", 0x014E)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagDotRange", 0x0150)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTargetPrinter", 0x0151)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExtraSamples", 0x0152)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSampleFormat", 0x0153)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSMinSampleValue", 0x0154)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSMaxSampleValue", 0x0155)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTransferRange", 0x0156)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGProc", 0x0200)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGInterFormat", 0x0201)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGInterLength", 0x0202)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGRestartInterval", 0x0203)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGLosslessPredictors", 0x0205)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGPointTransforms", 0x0206)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGQTables", 0x0207)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGDCTables", 0x0208)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGACTables", 0x0209)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYCbCrCoefficients", 0x0211)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYCbCrSubsampling", 0x0212)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYCbCrPositioning", 0x0213)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagREFBlackWhite", 0x0214)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGamma", 0x0301)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagICCProfileDescriptor", 0x0302)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSRGBRenderingIntent", 0x0303)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagImageTitle", 0x0320)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionXUnit", 0x5001)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionYUnit", 0x5002)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionXLengthUnit", 0x5003)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionYLengthUnit", 0x5004)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlags", 0x5005)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlagsVersion", 0x5006)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlagsCrop", 0x5007)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlagsBleedWidth", 0x5008)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlagsBleedWidthScale", 0x5009)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneLPI", 0x500A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneLPIUnit", 0x500B)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneDegree", 0x500C)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneShape", 0x500D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneMisc", 0x500E)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneScreen", 0x500F)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGQuality", 0x5010)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGridSize", 0x5011)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailFormat", 0x5012)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailWidth", 0x5013)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailHeight", 0x5014)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailColorDepth", 0x5015)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailPlanes", 0x5016)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailRawBytes", 0x5017)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailSize", 0x5018)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailCompressedSize", 0x5019)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagColorTransferFunction", 0x501A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailData", 0x501B)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailImageWidth", 0x5020)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailImageHeight", 0x5021)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailBitsPerSample", 0x5022)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailCompression", 0x5023)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailPhotometricInterp", 0x5024)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailImageDescription", 0x5025)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailEquipMake", 0x5026)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailEquipModel", 0x5027)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailStripOffsets", 0x5028)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailOrientation", 0x5029)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailSamplesPerPixel", 0x502A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailRowsPerStrip", 0x502B)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailStripBytesCount", 0x502C)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailResolutionX", 0x502D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailResolutionY", 0x502E)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailPlanarConfig", 0x502F)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailResolutionUnit", 0x5030)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailTransferFunction", 0x5031)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailSoftwareUsed", 0x5032)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailDateTime", 0x5033)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailArtist", 0x5034)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailWhitePoint", 0x5035)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailPrimaryChromaticities", 0x5036)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailYCbCrCoefficients", 0x5037)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailYCbCrSubsampling", 0x5038)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailYCbCrPositioning", 0x5039)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailRefBlackWhite", 0x503A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailCopyRight", 0x503B)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagLuminanceTable", 0x5090)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagChrominanceTable", 0x5091)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagFrameDelay", 0x5100)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagLoopCount", 0x5101)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGlobalPalette", 0x5102)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagIndexBackground", 0x5103)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagIndexTransparent", 0x5104)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPixelUnit", 0x5110)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPixelPerUnitX", 0x5111)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPixelPerUnitY", 0x5112)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPaletteHistogram", 0x5113)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagCopyright", 0x8298)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifExposureTime", 0x829A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFNumber", 0x829D)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifIFD", 0x8769)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagICCProfile", 0x8773)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifExposureProg", 0x8822)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSpectralSense", 0x8824)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsIFD", 0x8825)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifISOSpeed", 0x8827)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifOECF", 0x8828)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifVer", 0x9000)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTOrig", 0x9003)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTDigitized", 0x9004)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifCompConfig", 0x9101)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifCompBPP", 0x9102)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifShutterSpeed", 0x9201)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifAperture", 0x9202)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifBrightness", 0x9203)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifExposureBias", 0x9204)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifMaxAperture", 0x9205)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSubjectDist", 0x9206)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifMeteringMode", 0x9207)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifLightSource", 0x9208)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFlash", 0x9209)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFocalLength", 0x920A)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifMakerNote", 0x927C)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifUserComment", 0x9286)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTSubsec", 0x9290)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTOrigSS", 0x9291)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTDigSS", 0x9292)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFPXVer", 0xA000)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifColorSpace", 0xA001)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifPixXDim", 0xA002)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifPixYDim", 0xA003)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifRelatedWav", 0xA004)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifInterop", 0xA005)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFlashEnergy", 0xA20B)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSpatialFR", 0xA20C)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFocalXRes", 0xA20E)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFocalYRes", 0xA20F)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFocalResUnit", 0xA210)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSubjectLoc", 0xA214)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifExposureIndex", 0xA215)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSensingMethod", 0xA217)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFileSource", 0xA300)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSceneType", 0xA301)
        INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifCfaPattern", 0xA302)
        INDEX ON IDValue TO IDValue
    ENDPROC

*************************
    PROCEDURE retrievepropname
*************************
        LPARAMETERS tnPropertyID
        LOCAL lcReturn
        lcReturn = "Unknown"
        IF SEEK(tnPropertyID, "crsProps", "IDValue")
            lcReturn = crsProps.PropName
        ENDIF
        RETURN lcReturn
    ENDPROC

*************************
    PROCEDURE getimageproperties
*************************
        LOCAL lnMax
        DIMENSION aryProps(1)
        aryProps(1) = NULL
        WITH THIS
            lnMax = .GGetPropertyIDList(@aryProps)
            CREATE CURSOR crsEXIF (Property C(50), DATA C(100))
            FOR lnCounter = 1 TO lnMax
                INSERT INTO crsEXIF (Property, DATA) VALUES (.retrievepropname(aryProps(lnCounter)), TRANSFORM(.GGetPropertyItem(aryProps(lnCounter))))
            ENDFOR
            GO TOP IN crsEXIF
        ENDWITH
    ENDPROC

*************************
    PROCEDURE fillpropertygrid
*************************
        WITH THIS
            .createpropertycursor()
            .getimageproperties()
            .grid1.RECORDSOURCE = "crsEXIF"
            .grid1.REFRESH()
            * .grid1.AUTOFIT()
        ENDWITH
    ENDPROC

*************************
    PROCEDURE INIT
*************************
        LOCAL lcImageFile
        lcImageFile = GETPICT()
        IF EMPTY(lcImageFile)
           RETURN .F.
        ENDIF
        THIS.DeclareAPIs()
        IF This.GdipStartup()
           THIS.gpImageHandle = THIS.GGetImageHandle(lcImageFile)
           THIS.fillpropertygrid()
        ELSE
           RETURN .F.
        ENDIF 
    ENDPROC

*************************
    PROCEDURE DESTROY
*************************
        This.GdipShutdown()
        USE IN SELECT("crsProps")
        USE IN SELECT("crsEXIF")
    ENDPROC

*************************
    FUNCTION GGetPropertyCount()
*************************
        LOCAL lnCount
        m.lnCount = 0
        GdipGetPropertyCount(THIS.gpImageHandle, @m.lnCount)
        RETURN m.lnCount
    ENDFUNC

*************************
    FUNCTION GGetPropertyIDList(aryPropIDList)
*************************
        LOCAL lnCount, lcIdList, lnIndex
        m.lnCount = THIS.GGetPropertyCount()
        IF ISNULL(m.lnCount) OR m.lnCount < 1
            RETURN m.lnCount
        ENDIF

        m.lcIdList = REPLICATE(CHR(0), 4 * m.lnCount)
        GdipGetPropertyIdList(THIS.gpImageHandle, m.lnCount, @m.lcIdList)

        DIMENSION aryPropIDList(m.lnCount)
        FOR m.lnIndex = 1 TO m.lnCount
            aryPropIDList(m.lnIndex) = THIS.buf2num(SUBSTR(m.lcIdList, m.lnIndex * 4 - 3, 4))
        ENDFOR
        RETURN m.lnCount
    ENDFUNC

*************************
    FUNCTION GGetPropertyItem(tnPropID)
*************************
        LOCAL lnBufferSize, lnBufferPtr, lnStringPtr, ;
            lnPropertyTagType, lnValueLen, lnValuePtr, lvReturn

        m.lnBufferSize = 0

        GdipGetPropertyItemSize(THIS.gpImageHandle, m.tnPropID, @lnBufferSize)

        m.lnBufferPtr = GlobalAlloc(64, m.lnBufferSize)

        IF 0 == m.lnBufferPtr
            RETURN ""
        ENDIF

        GdipGetPropertyItem(THIS.gpImageHandle, m.tnPropID, ;
            m.lnBufferSize, m.lnBufferPtr)

        lnPropertyTagType = THIS.buf2num(THIS.GetMemString(m.lnBufferPtr + 8, 4))
        lnValueLen = THIS.buf2num(THIS.GetMemString(m.lnBufferPtr + 4, 4))
        lnValuePtr = THIS.buf2num(THIS.GetMemString(m.lnBufferPtr + 12, 4))

        DO CASE
            CASE INLIST(m.lnPropertyTagType,0,6,7,8)
                lvReturn = NULL
            CASE 1 == m.lnPropertyTagType
                lvReturn = ASC(THIS.GetMemString(m.lnValuePtr, 1))
            CASE 2 == m.lnPropertyTagType
                lvReturn = STREXTRACT(THIS.GetMemString(m.lnValuePtr, m.lnValueLen),'',CHR(0),1,2)
            CASE 3 == m.lnPropertyTagType
                lvReturn = ASC(THIS.GetMemString(m.lnValuePtr, 1)) + 256 * ASC(THIS.GetMemString(m.lnValuePtr + 1, 1))
            CASE 4 == m.lnPropertyTagType
                lvReturn = THIS.buf2num(THIS.GetMemString(m.lnValuePtr, 4))
            CASE 5 == m.lnPropertyTagType
                lvReturn = LTRIM(STR(THIS.buf2num(THIS.GetMemString(m.lnValuePtr, 4)))) + '/' ;
                    + LTRIM(STR(THIS.buf2num(THIS.GetMemString(m.lnValuePtr + 4, 4))))
            CASE 9 == m.lnPropertyTagType
                lvReturn = THIS.buf2num(THIS.GetMemString(m.lnValuePtr, 4))
                IF m.lvReturn > 2147483647
                    lvReturn = m.lvReturn - 4294967296
                ENDIF
            CASE 10 == m.lnPropertyTagType
                LOCAL lnNum, lnDen
                lnNum = THIS.buf2num(THIS.GetMemString(m.lnValuePtr, 4))
                lnDen = THIS.buf2num(THIS.GetMemString(m.lnValuePtr + 4, 4))
                IF m.lnNum > 2147483647
                    lnNum = m.lnNum - 4294967296
                ENDIF
                IF m.lnDen >2147483647
                    lnDen = m.lnDen - 4294967296
                ENDIF
                lvReturn = LTRIM(STR(m.lnNum)) +'/'+LTRIM(STR(m.lnDen))
            OTHERWISE
                GlobalFree(m.lnBufferPtr)
                RETURN ""
        ENDCASE
        GlobalFree(m.lnBufferPtr)
        RETURN m.lvReturn
    ENDFUNC

*************************
    FUNCTION GGetImageHandle(tcFilename)
*************************
        LOCAL lnHandle
        m.lnHandle = 0
        GdipLoadImageFromFile(THIS.a2u(m.tcFilename), @m.lnHandle)
        RETURN m.lnHandle
    ENDFUNC

************************
    FUNCTION buf2num(tcBuffer)
************************
        RETURN ASC(SUBSTR(tcBuffer, 1,1)) + ;
            ASC(SUBSTR(tcBuffer, 2,1)) * 2^8 + ;
            ASC(SUBSTR(tcBuffer, 3,1)) * 2^16 + ;
            ASC(SUBSTR(tcBuffer, 4,1)) * 2^24
    ENDFUNC

*************************
    FUNCTION GetMemString(tnString, tnMaxLength)
*************************
        LOCAL lcRet, lnNulfoundAt, lcReturn
        lcReturn = ""
        IF tnString != 0
            lcRet = SPACE(tnMaxLength)
            CopyMemory(@lcRet, tnString, LEN(lcRet))
            lnNulfoundAt = AT(CHR(0), lcRet)
            IF  lnNulfoundAt > 0
                lcRet = LEFT(lcRet, lnNulfoundAt - 1)
            ENDIF
            lcReturn = lcRet
        ENDIF
        RETURN lcReturn
    ENDFUNC

******************************
    FUNCTION a2u(tcStr)
******************************
#if Version(5) >= 700
        Return Strconv(tcStr + Chr(0), 5)
#else
        Local lnLen, lcWideStr
        lnLen = 2 * (Len(tcStr) + 1)
        lcWideStr = Replicate(Chr(0), lnLen)
        MultiByteToWideChar(0, 0, @tcStr, Len(tcStr), @lcWideStr, lnLen)
        Return lcWideStr
#endif
    ENDFUNC 
    

*************************
    PROCEDURE DeclareAPIs()
*************************
		Declare Long GdipLoadImageFromFile in GdiPlus.dll ;
			String FileName, Long @ GpImage
*!*	        DECLARE INTEGER GdipLoadImageFromFile IN GDIPLUS.DLL ;
*!*	            STRING wFilename, INTEGER @ nImage
        DECLARE INTEGER GdipGetPropertyCount IN GDIPLUS.DLL ;
            INTEGER nImage, INTEGER @nCount
        DECLARE INTEGER GdipGetPropertyIdList IN GDIPLUS.DLL ;
            INTEGER nImage, INTEGER nCount, STRING @ LIST
        DECLARE INTEGER GlobalAlloc IN kernel32.DLL ;
            INTEGER nFlags, INTEGER nSize
        DECLARE INTEGER GlobalFree IN kernel32.DLL ;
            INTEGER nHandle
        DECLARE INTEGER lstrlenA IN kernel32.DLL AS __win32_lstrlenA_ptr INTEGER
        DECLARE INTEGER GdipGetPropertyItemSize IN GDIPLUS.DLL ;
            INTEGER nImage, INTEGER nPropID, INTEGER @ nBufSize
        DECLARE INTEGER GdipGetPropertyItem IN GDIPLUS.DLL ;
            INTEGER nImage, INTEGER nPropID, INTEGER nBufSize, INTEGER nBufferPtr
        DECLARE RtlMoveMemory IN kernel32 AS CopyMemory;
            STRING @ Destination, INTEGER SOURCE, INTEGER nLength
        DECLARE INTEGER WideCharToMultiByte IN kernel32;
            INTEGER CodePg, INTEGER dwFlags,;
            STRING lpWideCharStr, INTEGER cchWideChar,;
            STRING @lpMultiByteStr, INTEGER cbMultiByte,;
            STRING lpDefaultChar, INTEGER lpUsedDefaultChar
        DECLARE INTEGER MultiByteToWideChar IN kernel32;
            INTEGER CODEPAGE, LONG dwFlags, STRING lpMultiByteStr,;
            INTEGER cbMultiByte, STRING @lpWCharStr, INTEGER cchWChar

		Declare Long GdiplusStartup in GdiPlus.dll ;
			Long @ token, String @ input, Long @ output
		Declare Long GdiplusShutdown in GdiPlus.dll ;
			Long token
    ENDPROC

    PROCEDURE GdipStartup()
    
  		Local gdiplusStartupInput, lcToken
	*	struct GdiplusStartupInput
	*	{
	*		UINT32 GdiplusVersion;				// Must be 1
	*		DebugEventProc DebugEventCallback;	// Ignored on free builds
	*		BOOL SuppressBackgroundThread;		// FALSE unless you're prepared to call 
	*											// the hook/unhook functions properly
	*		BOOL SuppressExternalCodecs;		// FALSE unless you want GDI+ only to use
	*											// its internal image codecs.
	*	}
		gdiplusStartupInput = Chr(1) + Replicate(Chr(0), 15)	&& GdiplusStartupInput structure (sizeof = 16)

		* Initialize GDI+.
		lcToken = 0
		If GdiplusStartup(@lcToken, @gdiplusStartupInput, 0) != 0
			Return .F.
		EndIf
		This.gdiplusToken = lcToken

    ENDPROC 
    
    PROCEDURE GdipShutdown()    
       GdiplusShutdown(This.gdiplusToken)
    ENDPROC 
ENDDEFINE

Bye, Olaf.

Neil Toulouse · Jan 25, 2006

Good point, if there is no EXIF data to report on, no values in the grid!

However(!!), STREXTRACT() function does not exist in VFP6 so I have an error a new error.

Neil

I like work. It fascinates me. I can sit and look at it for hours...

Olaf Doschke · Jan 25, 2006

Hi Neil,

There is only one occurance of STREXTRACT and it seems rather useless to me, as the GetMemString() Procedure already cares to get rid off and limit the string to the delimiter CHR(0)...

Simply search for "CASE 2 ==" and replace the CASE with:

Code:

CASE 2 == m.lnPropertyTagType
     lvReturn = THIS.GetMemString(m.lnValuePtr, m.lnValueLen)

It's located in the GGetPropertyItem Function.

Bye, Olaf.

Neil Toulouse · Jan 25, 2006

That's cracked it! Well done mate!

This should be turned into an FAQ methinks, as it could be a useful tool to some.

Eric, you sorted now?

I like work. It fascinates me. I can sit and look at it for hours...

craigsboyd · Jan 25, 2006

Olaf,

Thanks for jumping in and sorting out the remaining problems with this. Great job and Star for you.

SweetPotato Software Website
My Blog

eric43 · Jan 25, 2006

Hey Guys,

Jolly well done -I certainly haven't given up on it - its just that we sleep at different times downunder.

Thank you so much for all the effort - to see the final result after 6 months of trying after I first got the idea is truly something.

Stars to all who have helped me. This is the best return I've had amongst the 'hundreds' of questions I have asked in this forum.

And could someone please make a FAQ to help others.

Eric

eric43 · Jan 25, 2006

One last question ( promise).

I want to control the width of the two columns in the grid .

Anyone help?

Thanks Eric

eric43 · Jan 25, 2006

Belay that last request - I modified the procedure to

Code:

	PROCEDURE fillpropertygrid
*************************
	WITH THIS
		.createpropertycursor()
		.getimageproperties()
		.grid1.RECORDSOURCE = "crsEXIF"


		WITH .grid1.Column1   
			.Header1.Caption= 'EXIF'
			.Header1.Backcolor= RGB(255,255,255)
			.Header1.Forecolor = RGB(255,0,0)
			.Header1.FontBold = .t.
			.ReadOnly = .t.
			.Backcolor= RGB(255,255,255)
			.Forecolor = RGB(255,0,0)
			.Width = 300
			.FontBold = .t.
		ENDWITH

		WITH .grid1.Column2  
			.Header1.Caption= 'DATA'
			.ReadOnly = .t.
			.Width = 300
		ENDWITH

		.grid1.REFRESH()
* .grid1.AUTOFIT()
	ENDWITH
ENDPROC

Thanks again everyone.

Eric

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

VFP 6 - Getting at hidden picture information 10

Programmer

Programmer

IS-IT--Management

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

IS-IT--Management

Programmer

Programmer

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor