PureBasic Forums - English

Posted: **Fri Nov 29, 2013 10:11 pm**

When I show some pictures from my holiday trips to friends, I have to sort the photos before, because portrait images won't look fine in a dia show, other image formats may look bad on tablets and so on...

Therefore I wrote a tool, which crops a list of images depending on the target plattform. It also tries to do also other fine things, like adding title pages etc.

Just have a look here, I've also included some (small) sample images, which are used when start processing (F1)...

ShowRoom

Posted: **Fri Nov 29, 2013 11:53 pm**

Interesting idea! Nice touches in the GUI. Hell of a lot of options..... though that gives necessary flexibility, it makes the GUI a little bit bewildering.

It's not immediately obvious that if you have an existing Image File List, then the app 'knows' the Source drive path. If I browse to where the example ShowRoom.lst file is on my PC, the Source Drive Path is not updated to suit - and I can't browse to it. The List file then has the 'wrong' path stored. Therefore, Start Processing fails. All OK if you are defining a list from scratch. Expecting the 'average' User to edit a list with Notepad is sure to buy problems though.......

A better approach might be to:
1) Not hard code a file path in a list file;
2) Save the List file in the same folder as the images it is related to;
3) When the User browses for an existing List, the app then gets the path.
4) The above would work the same when defining an Image List file.

Posted: **Sat Nov 30, 2013 12:19 am**

You're right, need to add some hints (info buttons are already there, but no help)...
The image source path (relative or absolute) can be configured manually as well, after having set the auto mode to off.

I've tried to change a little bit now, hope it is fine for you: when entering '*' in the source image drive field, the path of the image source list file is taken... (New version).

For example, if the list file is "C:\ABC\xyz.lst" and the image source is set to "*" and "Test", the images will be searched in "C:\ABC\Test"; best is to test the different results by clicking on the info button which gives a hint what's going on with the path names

Posted: **Mon Nov 10, 2014 4:06 pm**

Hi,
I've added a module to view/modify Exif information of images in my ShowRoom program.

To do so, I need to store the information in an array and display it in a listicon gadget. When I started to use threads I got (sometimes) different memory access errors, but did not find the reason for them.

So I've extracted some code (see below) which also crashes (but not in the same lines as the original code). You should see the problem by starting the program below multiple times (please try out by using a valid jpg image including Exif information with debugging mode on).
Any ideas, what could be done to get rid of the problems?

Code: Select all

Global TestFile.s="C:\Users\...\Desktop\P1170192.JPG"

; Define

	EnableExplicit

	#ExifDateFormat="%YYYY:%MM:%DD %HH:%II:%SS"

	#ExifMinimumFileSize=256
	#ExifSOF=$FFD8
	#ExifApp1=$FFE1
	#ExifApp2=$FFE2
	#ExifHeaderOffset=6
	#ExifHeaderIFDLen=12
	#ExifHeaderTagExif=-#ExifHeaderOffset
	#ExifHeaderTagEndian=#ExifHeaderTagExif+6
	#ExifHeaderTagIFD=#ExifHeaderTagExif+10
	#ExifJpgSOF=$FFC0
	#ExifJpgSOS=$FFDA
	#ExifJpgCOM=$FFFE
	#ExifJpgCommentMaxLength=2000

	DataSection
		ExifTypeBytes:
		Data.b 1,1,1,2,4,8,1,1,2,4,8,4,8		; Bytegröße der einzelnen Exif-Datentypen
	EndDataSection
	;
	Enumeration
		#ExifGlobal
		#ExifMain
		#ExifMosaic
		#ExifThreads
	EndEnumeration
	;
	Structure ExifInfoType
		ExifMemory.i
		ExifDataSize.i
		ExifOffset.i
		ExifEndian.i
		JpgWidth.i
		JpgHeight.i
		JpgComment.s
		Date.i
		IntDate.i
		Rotation.i
		Width.i
		Height.i
		Information.s
	EndStructure
	;
	Global ExifDim.i=#ExifThreads
	Global Dim ExifInfo.ExifInfoType(#ExifThreads)

; EndDefine

Macro Long(x)
	((x)&$FFFFFFFF)
EndMacro
Macro Word(x)
	((x)&$FFFF)
EndMacro
Procedure SwapWord(w.w)

	ProcedureReturn ( ((w&$FF)<<8)|((w>>8)&$FF) )

EndProcedure
Procedure.s ExifGetString(nr,offset)

	If offset>=#Null And offset<ExifInfo(nr)\ExifDataSize
		ProcedureReturn PeekS(ExifInfo(nr)\ExifMemory+#ExifHeaderOffset+offset)
	Else
		ProcedureReturn ""
	EndIf

EndProcedure
Procedure.l ExifGetLong(nr,offset)

	Protected w.l

	If offset>=-#ExifHeaderOffset And offset<ExifInfo(nr)\ExifDataSize

		w=PeekL(ExifInfo(nr)\ExifMemory+#ExifHeaderOffset+offset);			#### \ExifMemory=Null ?! ####
		If ExifInfo(nr)\ExifEndian
			ProcedureReturn w&$FFFFFFFF
		Else
			ProcedureReturn ((w&$FF)<<24)|((w&$FF00)<<8)|((w&$FF0000)>>8)|((w>>24)&$FF)
		EndIf

	Else
		ProcedureReturn 0
	EndIf

EndProcedure
Procedure.w ExifGetWord(nr,offset)

	Protected w.w

	If offset>=#Null And offset<ExifInfo(nr)\ExifDataSize

		w=PeekW(ExifInfo(nr)\ExifMemory+#ExifHeaderOffset+offset)
		If ExifInfo(nr)\ExifEndian
			ProcedureReturn w&$FFFF
		Else
			ProcedureReturn (((w&$FF)<<8)|((w>>8)&$FF))
		EndIf

	Else
		ProcedureReturn 0
	EndIf

EndProcedure
Procedure.f ExifGetRational(nr,offset)

	Protected a.l,b.l

	If offset>=#Null And offset<ExifInfo(nr)\ExifDataSize

		a=ExifGetLong(nr,offset)
		b=ExifGetLong(nr,offset+4)

		ProcedureReturn a/b

	Else
		ProcedureReturn 0
	EndIf

EndProcedure
Procedure.s ExifGetRationalString(nr,offset)

	Protected a.l,b.l

	If offset>=#Null And offset<ExifInfo(nr)\ExifDataSize

		a=ExifGetLong(nr,offset)
		b=ExifGetLong(nr,offset+4)

		If b>1
			ProcedureReturn Str(a)+"/"+Str(b)
		Else
			ProcedureReturn Str(a)
		EndIf

	Else
		ProcedureReturn "-"
	EndIf

EndProcedure

Procedure ExifGetDirectory(nr,offset)

	Protected IFDTag
	Protected IFDOffset
	Protected MemOffset
	Protected n
	Protected x

	n=ExifGetWord(nr,offset)

	; Debug ">> "+Hex(nr)+" - "+Hex(offset)
	While n
		n-1
		MemOffset=n*#ExifHeaderIFDLen+2+offset
		IFDTag=Word(ExifGetWord(nr,MemOffset))
		IFDOffset=MemOffset+8

		If Long(ExifGetWord(nr,MemOffset+4))*PeekB(?ExifTypeBytes+Word(ExifGetWord(nr,MemOffset+2)))>4
			IFDOffset=Long(ExifGetLong(nr,IFDOffset))
		EndIf

		Select IFDTag

		Case $8769;		IFD1-Directory
			ExifGetDirectory(nr,Long(ExifGetLong(nr,IFDOffset)))
		Case $0112;		Image Rotation
			ExifInfo(nr)\Rotation=ExifGetWord(nr,IFDOffset)
		Case $0132;		Image creation date (Exif Internal)
			ExifInfo(nr)\IntDate=ParseDate(#ExifDateFormat,ExifGetString(nr,IFDOffset))
		Case $9003;		Image creation date (Original)
			ExifInfo(nr)\Date=ParseDate(#ExifDateFormat,ExifGetString(nr,IFDOffset))
		Case $A002;	Image Width
			ExifInfo(nr)\Width=ExifGetWord(nr,IFDOffset)
		Case $A003;	Image Height
			ExifInfo(nr)\Height=ExifGetWord(nr,IFDOffset)
		Case $C6D2;	Image Information (Panasonic)
			ExifInfo(nr)\Information=PeekS(ExifInfo(nr)\ExifMemory+#ExifHeaderOffset+IFDOffset)

		EndSelect
	Wend

EndProcedure
Procedure ExifGetFileInfo(nr,File.s)

	Protected Header
	Protected Ready
	Protected Daten

	If nr>ExifDim
		ExifDim=nr
		ReDim ExifInfo(ExifDim)
	EndIf


	With ExifInfo(nr)

		\IntDate=0;												#### Invalid Memory Access ####
		\JpgHeight=0
		\JpgWidth=0
		\JpgComment=""
		\Date=0
		\Rotation=0
		\Width=0
		\Height=0
		\Information=""

		If LCase(Right(File,4))=".jpg"
			If ReadFile(nr,File)
				If SwapWord(ReadWord(nr))=#ExifSOF
					Header=SwapWord(ReadWord(nr))
					If Header=#ExifApp1
						\ExifDataSize=SwapWord(ReadWord(nr))-2;		####  Array index out of bounds ####
						\ExifMemory=AllocateMemory(\ExifDataSize)
						If \ExifMemory
							If ReadData(nr,\ExifMemory,\ExifDataSize)=\ExifDataSize
								\ExifEndian=#Null
								If ExifGetLong(nr,#ExifHeaderTagExif)='Exif'
									\ExifEndian=(PeekA(\ExifMemory+#ExifHeaderOffset+#ExifHeaderTagEndian)&$FF)-'M'
									ExifGetDirectory(nr,ExifGetLong(nr,#ExifHeaderTagIFD))
								EndIf
							EndIf
							FreeMemory(\ExifMemory)
						EndIf
					Else
						FileSeek(nr,2);						
					EndIf

					Repeat
						Protected h=SwapWord(ReadWord(nr))

						Debug "Header 0x"+Hex(h)+" at Position "+Hex(Loc(nr))
						Select h
						Case #ExifJpgSOF;								
							Daten=SwapWord(ReadWord(nr))
							If Daten=$11
								Daten=ReadByte(nr)
								\JpgHeight=SwapWord(ReadWord(nr))
								\JpgWidth=SwapWord(ReadWord(nr))
								FileSeek(nr,10,#PB_Relative)
								Ready+1
							Else
								FileSeek(nr,Daten-2,#PB_Relative)
							EndIf

						Case #ExifJpgCOM;						
							Daten=SwapWord(ReadWord(nr))
							\JpgComment=ReadString(nr,#PB_Ascii,Daten-2)
							Ready+1

						Case #ExifJpgSOF To #ExifJpgCOM;				
							FileSeek(nr,SwapWord(ReadWord(nr))-2,#PB_Relative)

						Case #ExifJpgSOS;								
							Ready+10

						Default;						
							Ready+100

						EndSelect
					Until Ready>1

				EndIf
				CloseFile(nr)
			EndIf
		EndIf

	EndWith

EndProcedure
Procedure ExifToolSetInformation(nr)

	ExifGetFileInfo(nr,TestFile)

	With ExifInfo(nr)
		SetGadgetItemText(0,nr,FormatDate(#ExifDateFormat,\Date),1)
		SetGadgetItemText(0,nr,Str(\Width)+" x "+Str(\Height),2)
		SetGadgetItemText(0,nr,Str(\Rotation),3)
		SetGadgetItemText(0,nr,\Information,4)
		SetGadgetItemText(0,nr,\JpgComment,5)

	EndWith

EndProcedure

Procedure Main()
	Protected i.i

	OpenWindow(0, 0, 0, 640,800,"*", #PB_Window_SystemMenu)
	ListIconGadget(0,0,0,640,800,"1",30)

	For i=1 To 5
		AddGadgetColumn(0,i,Chr('0'+i),120)
	Next i

	For i=0 To 999
		AddGadgetItem(0,i,Str(i))
		CreateThread(@ExifToolSetInformation(),i)
		;WindowEvent()
	Next i

	Repeat
	Until WaitWindowEvent()=#PB_Event_CloseWindow

EndProcedure

Main()

Posted: **Mon Nov 10, 2014 7:51 pm**

Hi Michael,

a first look inside the code and I think I found the problem:

you ReDim the array while other threads work with this array.

I'll try to fix this now.

I think it's much better to work with a list.

Bernd

Posted: **Mon Nov 10, 2014 8:41 pm**

Not sure if it works correct.

With my Canon jpgs it doesn't work

Code: Select all

Global TestFile.s="d:\tmp\P1030506.jpg"

CompilerIf Not #PB_Compiler_Thread
  MessageRequester("Info", "You need to set the Thread-Save flag!")
  End
CompilerEndIf


; Define

   EnableExplicit

   #ExifDateFormat="%YYYY:%MM:%DD %HH:%II:%SS"

   #ExifMinimumFileSize=256
   #ExifSOF=$FFD8
   #ExifApp1=$FFE1
   #ExifApp2=$FFE2
   #ExifHeaderOffset=6
   #ExifHeaderIFDLen=12
   #ExifHeaderTagExif=-#ExifHeaderOffset
   #ExifHeaderTagEndian=#ExifHeaderTagExif+6
   #ExifHeaderTagIFD=#ExifHeaderTagExif+10
   #ExifJpgSOF=$FFC0
   #ExifJpgSOS=$FFDA
   #ExifJpgCOM=$FFFE
   #ExifJpgCommentMaxLength=2000

   DataSection
      ExifTypeBytes:
      Data.b 1,1,1,2,4,8,1,1,2,4,8,4,8      ; Bytegröße der einzelnen Exif-Datentypen
   EndDataSection
   ;
   Enumeration
      #ExifGlobal
      #ExifMain
      #ExifMosaic
      #ExifThreads
   EndEnumeration
   ;
   Structure ExifInfoType
      ExifMemory.i
      ExifDataSize.i
      ExifOffset.i
      ExifEndian.i
      JpgWidth.i
      JpgHeight.i
      JpgComment.s
      Date.i
      IntDate.i
      Rotation.i
      Width.i
      Height.i
      Information.s
   EndStructure
   ;
   Global ExifDim.i=#ExifThreads
   Global NewList ExifInfo.ExifInfoType()

; EndDefine

Macro Long(x)
   ((x)&$FFFFFFFF)
EndMacro
Macro Word(x)
   ((x)&$FFFF)
EndMacro
Procedure SwapWord(w.w)

   ProcedureReturn ( ((w&$FF)<<8)|((w>>8)&$FF) )

EndProcedure


Procedure.s ExifGetString(*ExifInfo.ExifInfoType, offset)
  
  If offset>=#Null And offset<*ExifInfo\ExifDataSize
    ProcedureReturn PeekS(*ExifInfo\ExifMemory+#ExifHeaderOffset+offset)
  Else
    ProcedureReturn ""
  EndIf
  
EndProcedure


Procedure.l ExifGetLong(*ExifInfo.ExifInfoType, offset)

   Protected w.l

   If offset>=-#ExifHeaderOffset And offset<*ExifInfo\ExifDataSize

      w=PeekL(*ExifInfo\ExifMemory+#ExifHeaderOffset+offset);         #### \ExifMemory=Null ?! ####
      If *ExifInfo\ExifEndian
         ProcedureReturn w&$FFFFFFFF
      Else
         ProcedureReturn ((w&$FF)<<24)|((w&$FF00)<<8)|((w&$FF0000)>>8)|((w>>24)&$FF)
      EndIf

   Else
      ProcedureReturn 0
   EndIf

EndProcedure
 
 
Procedure.w ExifGetWord(*ExifInfo.ExifInfoType, offset)

   Protected w.w

   If offset>=#Null And offset<*ExifInfo\ExifDataSize

      w=PeekW(*ExifInfo\ExifMemory+#ExifHeaderOffset+offset)
      If *ExifInfo\ExifEndian
         ProcedureReturn w&$FFFF
      Else
         ProcedureReturn (((w&$FF)<<8)|((w>>8)&$FF))
      EndIf

   Else
      ProcedureReturn 0
   EndIf

EndProcedure
 
Procedure.f ExifGetRational(*ExifInfo.ExifInfoType, offset)

   Protected a.l,b.l

   If offset>=#Null And offset<*ExifInfo\ExifDataSize

      a=ExifGetLong(*ExifInfo, offset)
      b=ExifGetLong(*ExifInfo, offset+4)

      ProcedureReturn a/b

   Else
      ProcedureReturn 0
   EndIf

EndProcedure
 
Procedure.s ExifGetRationalString(*ExifInfo.ExifInfoType, offset)

   Protected a.l,b.l

   If offset>=#Null And offset<*ExifInfo\ExifDataSize

      a=ExifGetLong(*ExifInfo, offset)
      b=ExifGetLong(*ExifInfo, offset+4)

      If b>1
         ProcedureReturn Str(a)+"/"+Str(b)
      Else
         ProcedureReturn Str(a)
      EndIf

   Else
      ProcedureReturn "-"
   EndIf

EndProcedure

Procedure ExifGetDirectory(*ExifInfo.ExifInfoType, offset)

   Protected IFDTag
   Protected IFDOffset
   Protected MemOffset
   Protected n
   Protected x

   n=ExifGetWord(*ExifInfo, offset)

   ; Debug ">> "+Hex(nr)+" - "+Hex(offset)
   While n
      n-1
      MemOffset=n*#ExifHeaderIFDLen+2+offset
      IFDTag=Word(ExifGetWord(*ExifInfo, MemOffset))
      IFDOffset=MemOffset+8

      If Long(ExifGetWord(*ExifInfo, MemOffset+4))*PeekB(?ExifTypeBytes+Word(ExifGetWord(*ExifInfo, MemOffset+2)))>4
         IFDOffset=Long(ExifGetLong(*ExifInfo, IFDOffset))
      EndIf

      Select IFDTag

      Case $8769;      IFD1-Directory
         ExifGetDirectory(*ExifInfo, Long(ExifGetLong(*ExifInfo, IFDOffset)))
      Case $0112;      Image Rotation
         *ExifInfo\Rotation=ExifGetWord(*ExifInfo, IFDOffset)
      Case $0132;      Image creation date (Exif Internal)
         *ExifInfo\IntDate=ParseDate(#ExifDateFormat,ExifGetString(*ExifInfo, IFDOffset))
      Case $9003;      Image creation date (Original)
         *ExifInfo\Date=ParseDate(#ExifDateFormat,ExifGetString(*ExifInfo, IFDOffset))
      Case $A002;   Image Width
         *ExifInfo\Width=ExifGetWord(*ExifInfo, IFDOffset)
      Case $A003;   Image Height
         *ExifInfo\Height=ExifGetWord(*ExifInfo, IFDOffset)
      Case $C6D2;   Image Information (Panasonic)
         *ExifInfo\Information=PeekS(*ExifInfo\ExifMemory+#ExifHeaderOffset+IFDOffset)

      EndSelect
   Wend

EndProcedure


Procedure ExifGetFileInfo(*ExifInfo.ExifInfoType, File.s)

   Protected Header
   Protected Ready
   Protected Daten
   Protected FileHandle
   
   
   With *ExifInfo

      \IntDate=0;                                    #### Invalid Memory Access ####
      \JpgHeight=0
      \JpgWidth=0
      \JpgComment=""
      \Date=0
      \Rotation=0
      \Width=0
      \Height=0
      \Information=""

      If LCase(Right(File,4))=".jpg"
        FileHandle = ReadFile(#PB_Any, File)
        If FileHandle
            If SwapWord(ReadWord(FileHandle))=#ExifSOF
               Header=SwapWord(ReadWord(FileHandle))
               If Header=#ExifApp1
                  \ExifDataSize=SwapWord(ReadWord(FileHandle))-2;      ####  Array index out of bounds ####
                  \ExifMemory=AllocateMemory(\ExifDataSize)
                  If \ExifMemory
                     If ReadData(FileHandle,\ExifMemory,\ExifDataSize)=\ExifDataSize
                       \ExifEndian=#Null
                       Debug Hex(ExifGetLong(*ExifInfo, #ExifHeaderTagExif))
                        If ExifGetLong(*ExifInfo, #ExifHeaderTagExif)= $45786966;'Exif'
                           \ExifEndian=(PeekA(\ExifMemory+#ExifHeaderOffset+#ExifHeaderTagEndian)&$FF)-'M'
                           ExifGetDirectory(*ExifInfo, ExifGetLong(*ExifInfo,#ExifHeaderTagIFD))
                        EndIf
                     EndIf
                     FreeMemory(\ExifMemory)
                  EndIf
               Else
                  FileSeek(FileHandle,2);
               EndIf

               Repeat
                  Protected h=SwapWord(ReadWord(FileHandle))

                  Debug "Header 0x"+Hex(h)+" at Position "+Hex(Loc(FileHandle))
                  Select h
                  Case #ExifJpgSOF;                        
                     Daten=SwapWord(ReadWord(FileHandle))
                     If Daten=$11
                        Daten=ReadByte(FileHandle)
                        \JpgHeight=SwapWord(ReadWord(FileHandle))
                        \JpgWidth=SwapWord(ReadWord(FileHandle))
                        FileSeek(FileHandle,10,#PB_Relative)
                        Ready+1
                     Else
                        FileSeek(FileHandle,Daten-2,#PB_Relative)
                     EndIf

                  Case #ExifJpgCOM;                  
                     Daten=SwapWord(ReadWord(FileHandle))
                     \JpgComment=ReadString(FileHandle,#PB_Ascii,Daten-2)
                     Ready+1

                  Case #ExifJpgSOF To #ExifJpgCOM;            
                     FileSeek(FileHandle,SwapWord(ReadWord(FileHandle))-2,#PB_Relative)

                  Case #ExifJpgSOS;                        
                     Ready+10

                  Default;                  
                     Ready+100

                  EndSelect
               Until Ready>1

            EndIf
            CloseFile(FileHandle)
         EndIf
      EndIf

   EndWith

EndProcedure
 
Procedure ExifToolSetInformation(nr)
  
  AddElement(ExifInfo())
  
  ExifGetFileInfo(@ExifInfo(), TestFile)
  
  With ExifInfo()
    SetGadgetItemText(0,nr,FormatDate(#ExifDateFormat,\Date),1)
    SetGadgetItemText(0,nr,Str(\Width)+" x "+Str(\Height),2)
    SetGadgetItemText(0,nr,Str(\Rotation),3)
    SetGadgetItemText(0,nr,\Information,4)
    SetGadgetItemText(0,nr,\JpgComment,5)
  EndWith
  
EndProcedure

Procedure Main()
   Protected i.i

   OpenWindow(0, 0, 0, 640,800,"*", #PB_Window_SystemMenu)
   ListIconGadget(0,0,0,640,800,"1",30)

   For i=1 To 5
      AddGadgetColumn(0,i,Chr('0'+i),120)
   Next i

   For i=0 To 999
      AddGadgetItem(0,i,Str(i))
      CreateThread(@ExifToolSetInformation(),i)
      ;WindowEvent()
   Next i

   Repeat
   Until WaitWindowEvent()=#PB_Event_CloseWindow

EndProcedure

Main()

Also the compare to 'Exif' was not working.

Bernd

Posted: **Tue Nov 11, 2014 8:16 am**

infratec wrote:Not sure if it works correct.
With my Canon jpgs it doesn't work
Code: Select all
...

Get an illegal memory access each time, but will check the 'redim' now, thanks for the tip. Concerning the Canon jpg files, maybe you can upload an example file, so I can check the exif header then.

Posted: **Tue Nov 11, 2014 8:19 am**

Hi Michael,

have you enabled Threadsave ???
I only get a crash when I remove this flag.

Bernd

Posted: **Tue Nov 11, 2014 8:48 am**

Canon Example

http://s3.postimg.org/kvk3rphhf/Canon_Exif.jpg

Posted: **Tue Nov 11, 2014 5:34 pm**

infratec wrote:Canon Example

http://s3.postimg.org/kvk3rphhf/Canon_Exif.jpg

Thanks, interesting, have not found the 'FFE0'-Tag in the Exif documentation, will do some investigations as soon as possible.

Posted: **Wed Nov 12, 2014 8:50 am**

Thanks again, without 'Redim' it works fine. I didn't knew, that even enlarging an array could lead to such problems.

The Exif information of the Canon image doesn't contain the width and height of the image, so I just take the jpg data to show the image size.

Code: Select all

Global TestFile="C:\Users\...\Desktop\Canon_Exif.JPG"

; Define

	EnableExplicit

	#ExifDateFormat="%YYYY:%MM:%DD %HH:%II:%SS"

	#ExifMinimumFileSize=256
	#ExifSOF=$FFD8
	#ExifCanon=$FFE0
	#ExifApp1=$FFE1
	#ExifApp2=$FFE2
	#ExifHeaderOffset=6
	#ExifHeaderIFDLen=12
	#ExifHeaderTagExif=-#ExifHeaderOffset
	#ExifHeaderTagEndian=#ExifHeaderTagExif+6
	#ExifHeaderTagIFD=#ExifHeaderTagExif+10
	#ExifJpgSOF=$FFC0
	#ExifJpgSOS=$FFDA
	#ExifJpgCOM=$FFFE
	#ExifJpgCommentMaxLength=2000

	DataSection
		ExifTypeBytes:
		Data.b 1,1,1,2,4,8,1,1,2,4,8,4,8		; Bytegröße der einzelnen Exif-Datentypen
	EndDataSection
	;
	Enumeration
		#ExifGlobal
		#ExifMain
		#ExifMosaic
		#ExifThreads
	EndEnumeration
	;
	Structure ExifInfoType
		ExifMemory.i
		ExifDataSize.i
		ExifOffset.i
		ExifEndian.i
		JpgWidth.i
		JpgHeight.i
		JpgComment.s
		Date.i
		IntDate.i
		Rotation.i
		Width.i
		Height.i
		Information.s
	EndStructure
	;
	Global ExifDim.i=#ExifThreads
	Global Dim ExifInfo.ExifInfoType(#ExifThreads)
	
	ExifDim=1000
	ReDim ExifInfo(ExifDim)
	
; EndDefine

Macro Long(x)
	((x)&$FFFFFFFF)
EndMacro
Macro Word(x)
	((x)&$FFFF)
EndMacro
Procedure SwapWord(w.w)

	ProcedureReturn ( ((w&$FF)<<8)|((w>>8)&$FF) )

EndProcedure
Procedure.s ExifGetString(nr,offset)

	If offset>=#Null And offset<ExifInfo(nr)\ExifDataSize
		ProcedureReturn PeekS(ExifInfo(nr)\ExifMemory+#ExifHeaderOffset+offset)
	Else
		ProcedureReturn ""
	EndIf

EndProcedure
Procedure.l ExifGetLong(nr,offset)

	Protected w.l

	If offset>=-#ExifHeaderOffset And offset<ExifInfo(nr)\ExifDataSize

		w=PeekL(ExifInfo(nr)\ExifMemory+#ExifHeaderOffset+offset);			#### \ExifMemory=Null ?! ####
		If ExifInfo(nr)\ExifEndian
			ProcedureReturn w&$FFFFFFFF
		Else
			ProcedureReturn ((w&$FF)<<24)|((w&$FF00)<<8)|((w&$FF0000)>>8)|((w>>24)&$FF)
		EndIf

	Else
		ProcedureReturn 0
	EndIf

EndProcedure
Procedure.w ExifGetWord(nr,offset)

	Protected w.w

	If offset>=#Null And offset<ExifInfo(nr)\ExifDataSize

		w=PeekW(ExifInfo(nr)\ExifMemory+#ExifHeaderOffset+offset)
		If ExifInfo(nr)\ExifEndian
			ProcedureReturn w&$FFFF
		Else
			ProcedureReturn (((w&$FF)<<8)|((w>>8)&$FF))
		EndIf

	Else
		ProcedureReturn 0
	EndIf

EndProcedure
Procedure.f ExifGetRational(nr,offset)

	Protected a.l,b.l

	If offset>=#Null And offset<ExifInfo(nr)\ExifDataSize

		a=ExifGetLong(nr,offset)
		b=ExifGetLong(nr,offset+4)

		ProcedureReturn a/b

	Else
		ProcedureReturn 0
	EndIf

EndProcedure
Procedure.s ExifGetRationalString(nr,offset)

	Protected a.l,b.l

	If offset>=#Null And offset<ExifInfo(nr)\ExifDataSize

		a=ExifGetLong(nr,offset)
		b=ExifGetLong(nr,offset+4)

		If b>1
			ProcedureReturn Str(a)+"/"+Str(b)
		Else
			ProcedureReturn Str(a)
		EndIf

	Else
		ProcedureReturn "-"
	EndIf

EndProcedure

Procedure ExifGetDirectory(nr,offset)

	Protected IFDTag
	Protected IFDOffset
	Protected MemOffset
	Protected n
	Protected x

	n=ExifGetWord(nr,offset)

	; Debug ">> "+Hex(nr)+" - "+Hex(offset)
	While n
		n-1
		MemOffset=n*#ExifHeaderIFDLen+2+offset
		IFDTag=Word(ExifGetWord(nr,MemOffset))
		IFDOffset=MemOffset+8

		If Long(ExifGetWord(nr,MemOffset+4))*PeekB(?ExifTypeBytes+Word(ExifGetWord(nr,MemOffset+2)))>4
			IFDOffset=Long(ExifGetLong(nr,IFDOffset))
		EndIf

		Select IFDTag

		Case $8769;		IFD1-Directory
			ExifGetDirectory(nr,Long(ExifGetLong(nr,IFDOffset)))
		Case $0112;		Image Rotation
			ExifInfo(nr)\Rotation=ExifGetWord(nr,IFDOffset)
		Case $0132;		Image creation date (Exif Internal)
			ExifInfo(nr)\IntDate=ParseDate(#ExifDateFormat,ExifGetString(nr,IFDOffset))
		Case $9003;		Image creation date (Original)
			ExifInfo(nr)\Date=ParseDate(#ExifDateFormat,ExifGetString(nr,IFDOffset))
		Case $A002;	Image Width
			ExifInfo(nr)\Width=ExifGetWord(nr,IFDOffset)
		Case $A003;	Image Height
			ExifInfo(nr)\Height=ExifGetWord(nr,IFDOffset)
		Case $C6D2;	Image Information (Panasonic)
			ExifInfo(nr)\Information=PeekS(ExifInfo(nr)\ExifMemory+#ExifHeaderOffset+IFDOffset)

		EndSelect
	Wend

EndProcedure
Procedure ExifGetFileInfo(nr,File.s)

	Protected Header
	Protected Ready
	Protected Daten

	If nr>ExifDim
		ExifDim=nr
		ReDim ExifInfo(ExifDim)
	EndIf
	
	Debug nr
	With ExifInfo(nr)

		\IntDate=0;												#### Invalid Memory Access ####
		\JpgHeight=0
		\JpgWidth=0
		\JpgComment=""
		\Date=0
		\Rotation=0
		\Width=0
		\Height=0
		\Information=""

		If LCase(Right(File,4))=".jpg"
			If ReadFile(nr,File)
				If SwapWord(ReadWord(nr))=#ExifSOF
					Header=SwapWord(ReadWord(nr))
					If Header=#ExifCanon
						Daten=SwapWord(ReadWord(nr))
						FileSeek(nr,Daten-2,#PB_Relative)
						Header=SwapWord(ReadWord(nr))
					EndIf
					If Header=#ExifApp1
						\ExifDataSize=SwapWord(ReadWord(nr))-2;		####  Array index out of bounds ####
						\ExifMemory=AllocateMemory(\ExifDataSize)
						If \ExifMemory
							If ReadData(nr,\ExifMemory,\ExifDataSize)=\ExifDataSize
								\ExifEndian=#Null
								If ExifGetLong(nr,#ExifHeaderTagExif)='Exif'
									\ExifEndian=(PeekA(\ExifMemory+#ExifHeaderOffset+#ExifHeaderTagEndian)&$FF)-'M'
									ExifGetDirectory(nr,ExifGetLong(nr,#ExifHeaderTagIFD))
								EndIf
							EndIf
							FreeMemory(\ExifMemory)
						EndIf
					Else
						FileSeek(nr,2);
					EndIf

					Repeat
						Protected h=SwapWord(ReadWord(nr))

						Debug "Header 0x"+Hex(h)+" at Position "+Hex(Loc(nr))
						Select h
						Case #ExifJpgSOF;
							Daten=SwapWord(ReadWord(nr))
							If Daten=$11
								Daten=ReadByte(nr)
								\JpgHeight=SwapWord(ReadWord(nr))
								\JpgWidth=SwapWord(ReadWord(nr))
								FileSeek(nr,10,#PB_Relative)
								Ready+1
							Else
								FileSeek(nr,Daten-2,#PB_Relative)
							EndIf

						Case #ExifJpgCOM;
							Daten=SwapWord(ReadWord(nr))
							\JpgComment=ReadString(nr,#PB_Ascii,Daten-2)
							Ready+1

						Case #ExifJpgSOF To #ExifJpgCOM;
							FileSeek(nr,SwapWord(ReadWord(nr))-2,#PB_Relative)

						Case #ExifJpgSOS;
							Ready+10

						Default;
							Ready+100

						EndSelect
					Until Ready>1

				EndIf
				CloseFile(nr)
			EndIf
		EndIf

	EndWith

EndProcedure
Procedure ExifToolSetInformation(nr)

	Protected s.s

	ExifGetFileInfo(nr,TestFile)

	With ExifInfo(nr)
		SetGadgetItemText(0,nr,FormatDate(#ExifDateFormat,\Date),1)

		s=Str(\Width)+" x "+Str(\Height)
		If s="0 x 0"
			s="("+Str(\JpgWidth)+" x "+Str(\JpgHeight)+")"
		EndIf
		SetGadgetItemText(0,nr,s,2)

		SetGadgetItemText(0,nr,Str(\Rotation),3)
		SetGadgetItemText(0,nr,\Information,4)
		SetGadgetItemText(0,nr,\JpgComment,5)

	EndWith

EndProcedure

Procedure Main()

	Protected i.i

	OpenWindow(0, 0, 0, 640,800,"*", #PB_Window_SystemMenu)
	ListIconGadget(0,0,0,640,800,"1",30)

	For i=1 To 5
		AddGadgetColumn(0,i,Chr('0'+i),120)
	Next i

	For i=0 To 999
		AddGadgetItem(0,i,Str(i))
		CreateThread(@ExifToolSetInformation(),i)
		;WindowEvent()
	Next i

	Repeat
	Until WaitWindowEvent()=#PB_Event_CloseWindow

EndProcedure

Main()

Posted: **Thu Nov 13, 2014 6:19 am**

Hi Michael Vogel,

I like the professional look/feel to your image ShowRoom tool.

Have you heard about Seam-Carving, it's a great alternative to cropping, and the algorithm is easy to implement.
- https://en.wikipedia.org/wiki/Seam_carving

There's a lot of documentation out there on the net, but if you would like to see a basic working example written in PureBasic:
- even though the package is OpenCV based, the Seam-Carving algorithm is mostly separate
-- http://www.purebasic.fr/english/viewtop ... 12&t=57457

Posted: **Thu Nov 13, 2014 8:51 am**

Hi Michael,

the problem with redim is, that it allocates new memory and copy the old array in the new bigger one.
So the old memory addresses are no longer available.
With a linked list you don't have this problem.
If an element is added only this element has a new location, the old ones stays at their address.

Is my version still crashing?

Bernd

Posted: **Thu Nov 13, 2014 9:08 pm**

JHPJHP,
great idea, never heard about image carving before.

I've downloaded the package (but won't have enough time for a while to check it in detail or to convert it to a 'standalone' procedure). Anyhow, this method should help me then to squeeze images in certain cases (for example to change 16:9 images to 4:4 format) but I have to check how to manage to reduce the image width (or height) for an exact number of pixels. I am also unsure if carving will be perfect to radically reduce the height of portrait images (see below) to be viewed on a landscape screen.

Bernd,
interenstingly, your code crashes dozend of times on one day and runs stable on another day - I have also used your modified code with having the same results. Are there any changes in the newer code (expect the compiler check)?

Thanks,
Michael

PureBasic Forums - English

Generate a photo album...

Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...

Re: Generate a photo album...