Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Image Attributes
Message
 
 
À
16/10/2002 15:59:59
Information générale
Forum:
Visual FoxPro
Catégorie:
Photos et traitement d'images
Divers
Thread ID:
00711944
Message ID:
00760349
Vues:
16
Here is a way to do it from ASP, in case you're interested. Code belongs to Brain Gaines:
' PURPOSE: This routine will attempt to identify any filespec passed as a graphic file (regardless of the extension). This will work with BMP, GIF, JPG and PNG files. This function gets a specified number of bytes from any file, starting at the offset (base 1)
' INPUTS: flnm - Filespec of file to read
'      offset - Offset at which to start reading
'      bytes - How many bytes to read
function GetBytes(flnm, offset, bytes)

Dim objFSO, objFTemp, objTextStream, lngSize

on error resume next

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' First, we get the filesize
    Set objFTemp = objFSO.GetFile(flnm)
    lngSize = objFTemp.Size
    Set objFTemp = Nothing
    
    fsoForReading = 1
    Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)
    
    if offset > 0 then
        strBuff = objTextStream.Read(offset - 1)
    end if
    
    ' Get All
    if bytes = -1 then    
        'ReadAll    
        GetBytes = objTextStream.Read(lngSize)  
    else
        GetBytes = objTextStream.Read(bytes)
    end if
    
    objTextStream.Close
    Set objTextStream = Nothing
    Set objFSO = Nothing

end function

' PURPOSE:     Functions to convert two bytes to a numeric value (long)
function lngConvert(strTemp)
    lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
end function

function lngConvert2(strTemp)
     lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
end function

' PURPOSE:     This function does most of the real work. It will attempt
'            to read any file, regardless of the extension, and will
'            identify if it is a graphical image.
' INPUTS:     flnm - Filespec of file to read
'            width - width of image   
'            height - height of image  
'            depth - color depth (in number of colors)
'            strImageType - type of image (e.g. GIF, BMP, etc.)
function gfxSpex(flnm, width, height, depth, strImageType)

    dim strPNG, strGIF, strBMP, strType

    strType = ""
    strImageType = "(unknown)"
    
    gfxSpex = False
    
    strPNG = chr(137) & chr(80) & chr(78)
    strGIF = "GIF"
    strBMP = chr(66) & chr(77)
    
    strType = GetBytes(flnm, 0, 3)
    
    if strType = strGIF then
    
        strImageType = "GIF"
        Width = lngConvert(GetBytes(flnm, 7, 2))
        Height = lngConvert(GetBytes(flnm, 9, 2))
        Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
        gfxSpex = True
    
    elseif left(strType, 2) = strBMP then
    
        strImageType = "BMP"
        Width = lngConvert(GetBytes(flnm, 19, 2))
        Height = lngConvert(GetBytes(flnm, 23, 2))
        Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
        gfxSpex = True
    
    elseif strType = strPNG then
    
        strImageType = "PNG"
        Width = lngConvert2(GetBytes(flnm, 19, 2))
        Height = lngConvert2(GetBytes(flnm, 23, 2))
        Depth = getBytes(flnm, 25, 2)
        
        select case asc(right(Depth,1))
           case 0
              Depth = 2 ^ (asc(left(Depth, 1)))
              gfxSpex = True
           case 2
              Depth = 2 ^ (asc(left(Depth, 1)) * 3)
              gfxSpex = True
           case 3
              Depth = 2 ^ (asc(left(Depth, 1)))  '8
              gfxSpex = True
           case 4
              Depth = 2 ^ (asc(left(Depth, 1)) * 2)
              gfxSpex = True
           case 6
              Depth = 2 ^ (asc(left(Depth, 1)) * 4)
              gfxSpex = True
           case else
              Depth = -1
        end select
        
    else
        
        ' Get all bytes from file
        strBuff = GetBytes(flnm, 0, -1)
        lngSize = len(strBuff)
        flgFound = 0
        
        strTarget = chr(255) & chr(216) & chr(255)
        flgFound = instr(strBuff, strTarget)
        
        if flgFound = 0 then
           exit function
        end if
        
        strImageType = "JPG"
        lngPos = flgFound + 2
        ExitLoop = false
    
        do while ExitLoop = False and lngPos < lngSize
        
           do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
              lngPos = lngPos + 1
           loop
        
           if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
              lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
              lngPos = lngPos + lngMarkerSize  + 1
           else
              ExitLoop = True
           end if
        
        loop
        
        if ExitLoop = False then
            Width = -1
            Height = -1
            Depth = -1    
        else
            Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
            Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
            Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
            gfxSpex = True    
        end if
    end if

end function


'USAGE EXAMPLE:
' get the dimensions of the file. We pass arguments 
' by reference to the gfxSpex function
' if there are dimensions to the file, then display 
' them, otherwise skip it.

dim w,h,c,strType
if gfxSpex(fil.Path, w, h, c, strType) then
  response.write "<td valign=top>" & w & " x " & h & "</td>"
else
  response.write "<td> </td>"
end if
>>Does anyone know how do get image attributes from VFP6? I need to be able to select an image and return the heighth and width of the image. I am working with JPEGs and TIFFs. Thank you.
>
>
>LOCAL loImage,lnWidth,lnHeight
>loImage=GetDimension('d:\iis\images\MyImage.gif')
>lnWidth=loImage.Width
>lnHeight=loImage.Height
>
>* Return an object to get the image dimensions
>* expC1 Full path of the file
>FUNCTION GetDimension
>PARAMETER tcFile
>loImage=CREATEOBJECT('Image')
>loImage.Picture=tcFile
>RETURN loImage
>
If it's not broken, fix it until it is.


My Blog
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform