Get Image resolution?

[collectordave]

Is it possible to get the actual resolution of an image on disk?

Regards

CD

[infratec]

Hi,

yes, open the file using ReadFile() and check the header

[RASHAD]

For Windows using GDI+
Fantastic code by NM modified by RASHAD

Code: Select all

;==================================================
;  Program:     GDIPlus Rotation Demo
;  Author:      netmaestro
;  Modified     RASHAD
;  Date:        November 12, 2006
;==================================================
Global bkgimage, resh.f, resv.f
#background = 0 ; image# for background

CompilerIf Defined(GdiplusStartupInput, #PB_Structure) = 0
  Structure GdiplusStartupInput
    GdiPlusVersion.l
    *DebugEventCallback.Debug_Event
    SuppressBackgroundThread.l
    SuppressExternalCodecs.l
  EndStructure
CompilerEndIf 

Procedure InitGDIPlus()
  OpenLibrary(0, "gdiplus.dll")
  input.GdiplusStartupInput
  input\GdiPlusVersion = 1
  CallFunction(0, "GdiplusStartup", @*token, @input, #Null)
  ProcedureReturn *token
EndProcedure

Procedure ShutDownGDIPlus(*token)
  CallFunction(0, "GdiplusShutdown", *token)
  CloseLibrary(0)
EndProcedure

Procedure StringToBStr (string$) ; By Zapman Inspired by Fr34k
  Protected Unicode$ = Space(Len(String$)* 2 + 2)
  Protected bstr_string.l
  PokeS(@Unicode$, String$, -1, #PB_Unicode)
  bstr_string = SysAllocString_(@Unicode$)
  ProcedureReturn bstr_string
EndProcedure

Procedure.l Max(n1.l,n2.l)
  !MOV Eax,dword[p.v_n1]
  !MOV Ecx,dword[p.v_n2]
  !CMP Ecx,Eax
  !cmovg Eax,Ecx
  ProcedureReturn
EndProcedure

Procedure.l Min(n1.l,n2.l)
  !MOV Eax,dword[p.v_n1]
  !MOV Ecx,dword[p.v_n2]
  !CMP Eax,Ecx
  !cmovg Eax,Ecx
	ProcedureReturn
EndProcedure

Procedure Load_Image(*image, bkgimage)
 CallFunction(lib, "GdipGetImageWidth", *image, @Width.l)
 CallFunction(lib, "GdipGetImageHeight", *image, @Height.l)
 CreateImage(bkgimage,Width,Height)
  hdc=StartDrawing(ImageOutput(bkgimage))
    Box(0,0,width,height,GetSysColor_(#COLOR_BTNFACE))
    CallFunction(0, "GdipCreateFromHDC", hdc, @*surface)
    CallFunction(0, "GdipDrawImageRectI", *surface, *image, 0 , 0, width,height)
  StopDrawing()
  If Width > 580 Or Height > 580
      Scale.f = 588/Max(Width,Height)
      ResizeImage(bkgimage,Width*Scale,Height*scale)
  EndIf
  CallFunction(0, "GdipDeleteGraphics", *surface) 
EndProcedure

*token = InitGDIPlus()

file$ = OpenFileRequester("Please choose file to load", "",  "Image (*.bmp;*.gif;*.jpeg;*.jpg;*.png;*.tif;*.tiff)" , 0)
If file$
  CallFunction(0, "GdipCreateBitmapFromFile",  StringToBStr(file$), @*image)
Else
  End
EndIf
CallFunction(0,"GdipGetImageHorizontalResolution",*image, @resh)
CallFunction(0,"GdipGetImageVerticalResolution",*image, @resv)
Debug "Horizontal resolution : "+ StrF(resh,0) +" DPI"
Debug "Vertical resolution   : "+ StrF(resv,0) +" DPI"

If *image <= 0
    Debug "No Image Loaded"
    End
 EndIf

OpenWindow(0,0,0,600,600,"Load Image",#PB_Window_ScreenCentered| #PB_Window_SystemMenu |#PB_Window_SizeGadget)
		ContainerGadget(0, 10, 10, 580, 580,#PB_Container_Flat)
		      ButtonImageGadget(1, -4,-4,588,588 , 0)
    CloseGadgetList()
    DisableGadget(0,1)
    Load_Image(*image, 0 )
    SetGadgetAttribute(1,#PB_Button_Image, ImageID(bkgimage))   
Repeat
  EventID = WindowEvent()
Until EventID = #PB_Event_CloseWindow

ShutDownGDIPlus(*token)

[JHPJHP]

Removed; answer applied to width / height, not DPI.

[infratec]

All provided solutions loads the whole picture into the memory

If you have to check many, many pictures that's the wrong way, then you can also use the normal LoadImage()
and check the width and height.

Faster is really to load only the header and extract the needed informations from there.

Bernd

[infratec]

A first step:

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf


Structure GetImageInfoStructure
  width.i
  height.i
  xdensity.i
  ydensity.i
EndStructure


Procedure.i GetImageInfoBMP(Filename$, *ImageInfo.GetImageInfoStructure)
  
  Protected Result.i, File.i ,*Buffer
  Protected *BMPCoreHeader.BITMAPCOREHEADER
  Protected *BMPInfoHeader.BITMAPINFOHEADER
  Protected *BMPV4Header.BITMAPV4HEADER
  Protected *BMPV5Header.BITMAPV5HEADER
  
  File = ReadFile(#PB_Any, Filename$)
  If File
    *Buffer = AllocateMemory(SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPV5HEADER), #PB_Memory_NoClear)
    If *Buffer
      If ReadData(File, *Buffer, MemorySize(*Buffer)) = MemorySize(*Buffer)
        Select PeekL(*Buffer + SizeOf(BITMAPFILEHEADER))
          Case 12
            *BMPCoreHeader = *Buffer + SizeOf(BITMAPFILEHEADER)
            *ImageInfo\width = *BMPCoreHeader\bcWidth
            *ImageInfo\height = *BMPCoreHeader\bcHeight
            Result = #True
          Case 40
            *BMPInfoHeader = *Buffer + SizeOf(BITMAPFILEHEADER)
            *ImageInfo\width = *BMPInfoHeader\biWidth
            *ImageInfo\height = *BMPInfoHeader\biHeight
            Result = #True
          Case 108
            *BMPV4Header = *Buffer + SizeOf(BITMAPFILEHEADER)
            *ImageInfo\width = *BMPV4Header\bV4Width
            *ImageInfo\height = *BMPV4Header\bV4Height
            Result = #True
          Case 124
            *BMPV5Header = *Buffer + SizeOf(BITMAPFILEHEADER)
            *ImageInfo\width = *BMPV5Header\bV5Width
            *ImageInfo\height = *BMPV5Header\bV5Height
            Result = #True
        EndSelect
      EndIf
      FreeMemory(*Buffer)
    EndIf
    CloseFile(File)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure




Procedure.i GetImageInfoJPG(Filename$, *ImageInfo.GetImageInfoStructure)
  
  Protected Result.i, File.i, ReadSize, *Buffer, Marker.u, Ptr.i
  
  
  File = ReadFile(#PB_Any, Filename$)
  If File
    *Buffer = AllocateMemory(30 * 1024,  #PB_Memory_NoClear)
    If *Buffer
      If Lof(File) < MemorySize(*Buffer)
        ReadSize = Lof(File)
      Else
        ReadSize = MemorySize(*Buffer)
      EndIf
      If ReadData(File, *Buffer, ReadSize) = ReadSize
        If PeekU(*Buffer) = $D8FF
          Ptr = 2
          Repeat
            Marker = PeekU(*Buffer + Ptr)
            ;Debug Hex(Marker)
            
            If Marker = $E0FF ; should be the first marker after FFD8
              If PeekA(*Buffer + Ptr + 11)
                *ImageInfo\xdensity = ((PeekA(*Buffer + Ptr + 12) << 8) | PeekA(*Buffer + Ptr + 13))
                *ImageInfo\ydensity = ((PeekA(*Buffer + Ptr + 14) << 8) | PeekA(*Buffer + Ptr + 15))
              Else
                *ImageInfo\xdensity = 0
                *ImageInfo\ydensity = 0
              EndIf
            EndIf
            
            If Marker = $C0FF
              *ImageInfo\height = ((PeekA(*Buffer + Ptr + 5) << 8) | PeekA(*Buffer + Ptr + 6))
              *ImageInfo\width = ((PeekA(*Buffer + Ptr + 7) << 8) | PeekA(*Buffer + Ptr + 8))
              Result = #True
              Break
            EndIf
            
;             If *ImageInfo\width And *ImageInfo\xdensity
;               Break
;             EndIf
            
            Ptr + 2
            
            Ptr + ((PeekA(*Buffer + Ptr) << 8) | PeekA(*Buffer + Ptr + 1))
          Until Ptr >= ReadSize
        EndIf
      EndIf
      
      FreeMemory(*Buffer)
    EndIf
    CloseFile(File)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure




Procedure.i GetImageInfoPNG(Filename$, *ImageInfo.GetImageInfoStructure)
  
  Protected Result.i, File.i, *Buffer
  
  
  File = ReadFile(#PB_Any, Filename$)
  If File
    *Buffer = AllocateMemory(24,  #PB_Memory_NoClear)
    If *Buffer
      If ReadData(File, *Buffer, MemorySize(*Buffer)) = MemorySize(*Buffer)
        If PeekA(*Buffer + 0) = $89 And PeekA(*Buffer + 1) = 'P' And PeekA(*Buffer + 2) = 'N' And PeekA(*Buffer + 3) = 'G'
          If PeekA(*Buffer + 12) = 'I' And PeekA(*Buffer + 13) = 'H' And PeekA(*Buffer + 14) = 'D' And PeekA(*Buffer + 15) = 'R'
            *ImageInfo\width = PeekA(*Buffer + 16) << 24 | PeekA(*Buffer + 17) << 16 | PeekA(*Buffer + 18) << 8 | PeekA(*Buffer + 19)
            *ImageInfo\height = PeekA(*Buffer + 20) << 24 | PeekA(*Buffer + 21) << 16 | PeekA(*Buffer + 22) << 8 | PeekA(*Buffer + 23)
            Result = #True
          EndIf
        EndIf
      EndIf
      FreeMemory(*Buffer)
    EndIf
    CloseFile(File)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure




Procedure.i GetImageInfoGIF(Filename$, *ImageInfo.GetImageInfoStructure)
  
  Protected Result.i, File.i, *Buffer
  
  
  File = ReadFile(#PB_Any, Filename$)
  If File
    *Buffer = AllocateMemory(10,  #PB_Memory_NoClear)
    If *Buffer
      If ReadData(File, *Buffer, MemorySize(*Buffer)) = MemorySize(*Buffer)
        If PeekS(*Buffer, 3, #PB_Ascii) = "GIF"
          *ImageInfo\width = PeekU(*Buffer + 6)
          *ImageInfo\height = PeekU(*Buffer + 8)
          Result = #True
        EndIf
      EndIf
      FreeMemory(*Buffer)
    EndIf
    CloseFile(File)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure




Procedure.i GetImageInfoICO(Filename$, *ImageInfo.GetImageInfoStructure)
  
  Protected Result.i, File.i, *Buffer
  
  
  File = ReadFile(#PB_Any, Filename$)
  If File
    *Buffer = AllocateMemory(8,  #PB_Memory_NoClear)
    If *Buffer
      If ReadData(File, *Buffer, MemorySize(*Buffer)) = MemorySize(*Buffer)
        If PeekU(*Buffer) = 0 And (PeekU(*Buffer + 2) = 1 Or PeekU(*Buffer + 2) = 2)
          *ImageInfo\width = PeekA(*Buffer + 6)
          *ImageInfo\height = PeekA(*Buffer + 7)
          Result = #True
        EndIf
      EndIf
      FreeMemory(*Buffer)
    EndIf
    CloseFile(File)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure




Procedure.i GetImageInfo(Filename$, *ImageInfo.GetImageInfoStructure)
  
  Protected Result.i
  
  
  If Filename$ <> ""
    
    Select LCase(GetExtensionPart(Filename$))
      Case "bmp"
        Result = GetImageInfoBMP(Filename$, *ImageInfo)
      Case "jpg"
        Result = GetImageInfoJPG(Filename$, *ImageInfo)
      Case "png"
        Result = GetImageInfoPNG(Filename$, *ImageInfo)
      Case "gif"
        Result = GetImageInfoGIF(Filename$, *ImageInfo)
      Case "ico"
        Result = GetImageInfoICO(Filename$, *ImageInfo)
    EndSelect
    
  EndIf
  
  ProcedureReturn Result
  
EndProcedure



CompilerIf #PB_Compiler_IsMainFile
  
  Define Filename$, Info$, ImageInfo.GetImageInfoStructure
  
;   Filename$ = OpenFileRequester("Choose an Image", "", "IMG|*.bmp;*.jpg;*.png;*.gif;*.ico", 0)
;   If Filename$ <> ""
;     If GetImageInfo(Filename$, @ImageInfo)
;       Debug GetFilePart(Filename$) + " -> " + Str(ImageInfo\width) + "x" + Str(ImageInfo\height)
;     Else
;       MessageRequester("Info", "Sorry, I was not able to extract the resolution.")
;     EndIf
;   EndIf
  
  Define Dir$, Dir.i
  
  Dir$ = PathRequester("Choose a directory", "")
  If Dir$ <> ""
    Dir = ExamineDirectory(#PB_Any, Dir$, "*.*")
    If Dir
      While NextDirectoryEntry(Dir)
        If DirectoryEntryType(Dir) = #PB_DirectoryEntry_File
          Filename$ = DirectoryEntryName(Dir)
          ImageInfo\xdensity = 0
          ImageInfo\ydensity = 0
          If GetImageInfo(Dir$ + Filename$, @ImageInfo)
            Info$ = Filename$ + " -> " + Str(ImageInfo\width) + "x" + Str(ImageInfo\height)
            If ImageInfo\xdensity
              Info$ + " " + Str(ImageInfo\xdensity) + " by " + Str(ImageInfo\ydensity)
            EndIf
            Debug Info$
          EndIf
        EndIf
      Wend
      FinishDirectory(Dir)
    EndIf
  EndIf
  
CompilerEndIf

Bernd

[RASHAD]

Hi Bernd
I am confused right now
Did he asked for Image width & height or Image resolution DPI?
For Image dimensions without loading there are 2 samples :
1- Using comate +
2- A snippet by MV

[infratec]

Hm...

maybe you are right.
CD has to tell us what he mean exactly.

Btw.: added jpg

Bernd

[nco2k]

shell to the rescue: http://www.purebasic.fr/english/viewtop ... 12&t=69458

c ya,
nco2k

[infratec]

Hm...

I think my 'direct' way is faster.

PNG added.

Bernd

[infratec]

GIF added

[nco2k]

of course its faster. but you will have to support every current and upcoming image format in the world, including all those files with buggy headers. faster is not always the best choice.

c ya,
nco2k

[infratec]

As always: it depends on the needs.
If you want to scan a directory with 1000 images inside ...

And if a new image format appears, also MS has to update the software.

ICO added.

Btw. jpg is a bit tricky, because the location of the information can be far away from the file start.

Now I have to go to bed.
Good night.

[nco2k]

>> As always: it depends on the needs.
true.

well, currently you just assume that the file extension + header is correct. sometimes a file doesnt have an extension, and sometimes it has the wrong extension. you have to check, if the png etc. file, is really a png etc. file, before you read out its values. the quality control is a really annoying task, when you have to deal with so many different image formats. i have done something like this in the past, but i dont have the sourcecode anymore unfortunately. :/ anyway, best of luck to you.

c ya,
nco2k

[Demivec]

Just for kicks here's a link to an older thread with some discussion and code techniques for this that might be useful on other OS's also.

http://www.purebasic.fr/english/viewtopic.php?f=13&t=61890