Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
IfPictureFile() custom function
Message
From
23/01/2007 06:42:19
Metin Emre
Ozcom Bilgisayar Ltd.
Istanbul, Turkey
 
 
To
23/01/2007 05:39:21
General information
Forum:
Visual FoxPro
Category:
Pictures and Image processing
Miscellaneous
Thread ID:
01188001
Message ID:
01188020
Views:
19
Thanks Tore,

>>Hi All,
>>I was looking for extension "JPG", "BMP", "GIF" for picture files but VFP supports a lot of picture types now.
>>
>>I think so a function should like IfPictureFile() for check a file if it is an image file which VFP can show. How can I do that?
>
>I created this function a few years ago, it determines the file type based on it's contents. I can not guarantee that it's 100% accurate, but I have not had any trouble with it. This function together with a simple Inlist() should give you what you want.
>
>
>Function filetype
>  Lparameters lcData
>  Local lcReturn,lcContents
>  If Pcount()=0 Or Vartype(lcData)#'C'
>    lcReturn=''
>  Else
>    If Adir(laDummy,lcData)>0 && File
>      lcContents=Filetostr(lcData)
>    Else && Memory variabøe
>      lcContents=lcData
>    Endif
>    Do Case
>      Case Len(lcContents)<4
>        lcReturn=''
>      Case Left(lcContents,3)=Chr(0xFF)+Chr(0xD8)+Chr(0xFF)
>        lcReturn='JPG'
>      Case Left(lcContents,3)='GIF'
>        lcReturn='GIF'
>      Case Substr(lcContents,42,3)='EMF'
>        lcReturn='EMF'
>      Case Left(lcContents,4)=Chr(0xD7)+Chr(0xCD)+Chr(0xC6)+Chr(0x9A)
>        lcReturn='WMF'
>      Case Left(lcContents,4)=Chr(0x4D)+Chr(0x4D)+Chr(0x00)+Chr(0x2A)
>        lcReturn='TIF'
>      Case Left(lcContents,4)=Chr(0x89)+'PNG'
>        lcReturn='PNG'
>      Case Left(lcContents,2)='BM'
>        lcReturn='BMP'
>      Case Left(lcContents,3)='CWS' And Asc(Substr(lcContents,4,1))<16
>        lcReturn='SWF'
>      Case Left(lcContents,3)='FWS'  And Asc(Substr(lcContents,4,1))<16
>        lcReturn='SWF'
>      Otherwise
>        lcReturn=''
>    Endcase
>  Endif
>Return lcReturn
>
Previous
Reply
Map
View

Click here to load this message in the networking platform