Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Image Attributes
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Photos et traitement d'images
Divers
Thread ID:
00711944
Message ID:
00760360
Vues:
20
Here is a translated from VB code, in case if somebody is interested. VB class CImageInfo belongs to David Crowell:
Usage:
ii = CreateObject("ImageInfo")
ii.ReadInfo("sample.jpg")
? ii.ImageWidth, ii.ImageHeight
? ii.ImageDepth, ii.ImageType
* Only the first X bytes of the file are read into a byte array.
* BUFFERSIZE is X.  A larger number will use more memory and
* be slower.  A smaller number may not be able to decode all
* JPEG files.  Feel free to play with this number.
#define BUFFERSIZE	4096

* image type enum
#define itUNKNOWN	0
#define itGIF		1
#define itJPEG		2
#define itPNG		3
#define itBMP		4

Define Class ImageInfo as Custom
	* protected member variables
	ImageWidth = 0
	ImageHeight = 0
	ImageDepth = 0
	ImageType = 0
	Protected bBuf

	Procedure ReadInfo(sFileName)
	* This is the sub to call to retrieve information on a file.
    
		* Open file number
		Local iFN

		* Set all properties to default values
		This.ImageWidth = 0
		This.ImageHeight = 0
		This.ImageDepth = 0
		This.ImageType = itUNKNOWN

		* here we will load the first part of a file into a byte array
		* the amount of the file stored here depends on the BUFFERSIZE
		* constant
		iFN = Fopen(sFileName)
		This.bBuf = Fread(iFN, BUFFERSIZE)
		Fclose(iFN)

		If Left(This.bBuf, 3) == Chr(137) + Chr(80) + Chr(78)
		* this is a PNG file

			This.ImageType = itPNG

			* get bit depth
			d = Asc(Substr(This.bBuf, 26))
			Do Case
			Case d = 0			&& greyscale
			    This.ImageDepth = Asc(Substr(This.bBuf, 25))
			Case d = 2			&& RGB encoded
			    This.ImageDepth = Asc(Substr(This.bBuf, 25)) * 3
			Case d = 3			&& Palette based, 8 bpp
			    This.ImageDepth = 8
			Case d = 4			&& greyscale with alpha
			    This.ImageDepth = Asc(Substr(This.bBuf, 25)) * 2
			Case d = 6			&& RGB encoded with alpha
			    This.ImageDepth = Asc(Substr(This.bBuf, 25)) * 4
			Otherwise
			* This value is outside of it's normal range, so we'll assume
			* that this is not a valid file
			    This.ImageType = itUNKNOWN
	        EndCase
        
			If This.ImageType > 0
			* if the image is valid then

				* get the width
				This.ImageWidth = This.Mult(20, 19)

				* get the height
				This.ImageHeight = This.Mult(24, 23)
				Return
			EndIf
		EndIf

		If Left(This.bBuf, 3) == "GIF"
		* this is a GIF file

			This.ImageType = itGIF

			* get the width
			This.ImageWidth = This.Mult(7, 8)

			* get the height
			This.ImageHeight = This.Mult(9, 10)

			* get bit depth
			This.ImageDepth = Bitand(Asc(Substr(This.bBuf, 11)), 7) + 1
			Return
		EndIf

		If Left(This.bBuf, 2) == "BM"
		* this is a BMP file

			This.ImageType = itBMP

			* get the width
			This.ImageWidth = This.Mult(19, 20)

			* get the height
			This.ImageHeight = This.Mult(23, 24)

			* get bit depth
			This.ImageDepth = Asc(Substr(This.bBuf, 29))
			Return
		EndIf

		* if the file is not one of the above type then
		* check to see if it is a JPEG file
		Local lPos
		lPos = At(Chr(0xFF) + Chr(0xD8) + Chr(0xFF), This.bBuf)

		* loop through looking for the byte sequence FF,D8,FF
		* which marks the begining of a JPEG file
		* lPos will be left at the position of the start
		If lPos = 0
			Return
		EndIf
    
		lPos = lPos + 2
		If lPos > BUFFERSIZE - 10
			Return
		EndIf

		DO While .T.
		* loop through the markers until we find the one starting with FF,C0
		* which is the block containing the image information

			DO While .T.
			* loop until we find the beginning of the next marker
				If (Asc(Substr(This.bBuf, lPos)) = 0xFF) And (Asc(Substr(This.bBuf, lPos + 1)) != 0xFF)
					Exit
				EndIf
				lPos = lPos + 1
				If lPos > BUFFERSIZE - 10
					Return
				EndIf
			EndDo

			* move pointer up
			lPos = lPos + 1

			If InList(Asc(Substr(This.bBuf, lPos)), ;
				0xC0, 0xC1, 0xC2, 0xC3, 0xC5, 0xC6, 0xC7, 0xC9, 0xCA, 0xCB, 0xCD, 0xCE, 0xCF)
			* we found the right block
				Exit
			EndIf

			* otherwise keep looking
			lPos = lPos + This.Mult(lPos + 2, lPos + 1)

			* check for end of buffer
			If lPos > BUFFERSIZE - 10
				Return
			EndIf
		EndDo

		* If we've gotten this far it is a JPEG and we are ready
		* to grab the information.

		This.ImageType = itJPEG

		* get the height
		This.ImageHeight = This.Mult(lPos + 5, lPos + 4)

		* get the width
		This.ImageWidth = This.Mult(lPos + 7, lPos + 6)

		* get the color depth
		This.ImageDepth = Asc(Substr(This.bBuf, lPos + 8)) * 8
	EndProc

	Protected Function Mult(lsb, msb)
		Return Asc(Substr(This.bBuf, lsb)) + Asc(Substr(This.bBuf, msb)) * 256
	EndFunc
EndDefine
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform