I hope anyone of the PureBasic community can help me finding the mistake.
Short description what the programm should do:
After travelling in holiday I am cutting mp4-videos from my pictures where the pic's and vid' are used in chronological mode like in a dairy.
I am photographing with my Digital-Camera, my pixel 6a-phone and my wife with her iPhone. So all types of pics have different syntax in the filenames, one has the shooting-date in the filename the others not
You can sort with win10 refering the date of beeing shot, but this not perfect!
To have the pic's in the project-folder in chronological way I want to copy the pic's into a folder "Date-Renamed" under the original-folder with a filename like "Exif_DigitzedDateTime_Filename.ext" = "20231004_120533-filename.ext" So it can be sorted perfectly.
That should be done by this software.
- If not existing the folder will be created >> thats OK.
- The selection-bar should be set to the first entry of the explorerlist left >> is not OK, is not becoming blue!
- Then the folder with the original pic's will be worked down 1 by 1 in a while-Wend loop >> thats OK.
- Each file should be displayed in the preview-box >> thats OK
- All Exif-date should be read >> I think it is OK??!!
- The exif-data should be displayd in the center listbox >> it is not OK.
- The DigitizedDateTime-value should be fetched from the Listbox, the new name will be made in the way "DigitizedDateTime_Filename.ext" >> cannot be done because the data are not in the listbox
- The original file should be copied into the "Date-Renamed"-Folder >> its OK
- The loop should be canceld by a button "#GADGET_Button_rename_abort" >> its not OK, loop is not canceld.
Clicking directly to the filename everything works perfect, picture will be shown in the preview-area and all exif-data will be shown in the listbox.
Search for MISTAKE in the code and you will find the Procedure which is not working.
I hope I have described the problem in an understandable english ??? I'm a german old man!
Thanks in advance
Rainer
Code: Select all
;/=====================================================================================================================
;| File : ExifDataTestApp.pb
;| Purpose : Show the DateTime Information stored in the Exif data field of Jpeg Files.
;| Read information is available only.
;|
;| Specification has so much more information to share...
;|
;| Version : 0.02
;|
;| State : Experimental, tested on only a few jpg images
;|
;| OS : Tested on Windows x64 with ASM Backend only
;|
;| License : MIT
;|
;| Copyright (c) 2022 by A.H. (Axolotl)
;|
;| ChangeLog :
;| 0.01 .. first attempt (published on forum)
;| Link:
;|
;| 0.02 .. added new TAG ImageDescription
;| adapted main window with improved Preview for long values
;|
;|
;\=====================================================================================================================
EnableExplicit
; DebugLevel 9 ; show all debug messages
Global Rename_Path.s, Only_filename.s, Rename_Abort.i = 0, file.s, index.i, Original_Path.s, Abort_event.i
; ---== MainWindow ==--------------------------------------------------------------------------------------------------
#ProgramName$ = "ExifDataTestApp"
#ProgramVersion$ = "0.02" ; internally used + #PB_Editor_BuildCount + "." + #PB_Editor_CompileCount
#MainCaption$ = "Image Exif Data and more... V" + #ProgramVersion$ + " ~ EXPERIMENTAL "
Enumeration EWindow 1 ; -----------------------------------------------------------------------------
#WINDOW_Main
EndEnumeration
Enumeration EGadget 1 ; -----------------------------------------------------------------------------
#GADGET_ExpImageFiles
#GADGET_LstImageInfo
#GADGET_CnvPreView
#GADGET_EdtPreView ; show selected items (especially very long values)
#Frame3D_0
#Frame3D_1
#Frame3D_2
#GADGET_Source_path
#GADGET_Source_path_show
#GADGET_Target_path
#GADGET_Target_path_show
#GADGET_Button_exit
#GADGET_Button_rename
#GADGET_Original_file
#GADGET_Original_file_show
#GADGET_Renamed_file
#GADGET_Renamed_file_show
#GADGET_Button_rename_abort
#GADGET_ExplorerTree
EndEnumeration
Enumeration EImage 1 ; -----------------------------------------------------------------------------
#IMAGE_PreView
EndEnumeration
; -----------------------------------------------------------------------------
; The example app shows the image, too.
; -----------------------------------------------------------------------------
UseJPEGImageDecoder()
UsePNGImageEncoder()
UseJPEG2000ImageDecoder()
; ---== Exif Imaage Data ==--------------------------------------------------------------------------------------------
DeclareModule ExifData ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; ---------------------------------------------------------------------------
; Constants
;
Enumeration EExifTAG ; Number of the TAG (Exif, TIFF, etc.)
#ExifTAG_ImageWidth = $0100 ; recommended not to use, better use jpeg
#ExifTAG_ImageHeight = $0101 ; recommended not to use, better use jpeg
#ExifTAG_BitsPerSample = $0102 ;
#ExifTAG_Compression = $0103 ; thumbnail stuff ..
;
#ExifTAG_Orientation = $0112 ;
#ExifTAG_XResolution = $011A ;
#ExifTAG_YResolution = $011B ;
#ExifTAG_ResolutionUnit = $0128 ;
; ;
; new
#ExifTAG_ImageDescription = $010E ; char string giving the title of the image (no two-char codes)
; ;
#ExifTAG_Make = $010F ; "Make", #Exif_Type_ASCII, -1, 0)
#ExifTAG_Model = $0110 ; "Model", #Exif_Type_ASCII, -1, 0)
#ExifTAG_Software = $0131 ; "Software", #Exif_Type_ASCII, -1, 0)
#ExifTAG_DateTime = $0132 ; "DateTime", #Exif_Type_ASCII, 20, 0)
#ExifTAG_Artist = $013B ; name of the camera owner, photographer or image creator
#ExifTAG_Copyright = $8298 ; indicate both the photographer and editor copyrights
;
#ExifTAG_ExifVersion = $9000 ; 36864 (9000.H) | UNDEFINED | 4 | "0232" ; no NULL termination
#ExifTAG_ExifFlashpixVersion = $A000 ; 40960 (A000.H) | UNDEFINED | 4 | "0100" ; Flashpix Format Version 1.0
;
#ExifTAG_DateTimeOriginal = $9003 ; 36867 (9003.H) | ASCII | 20 | None
#ExifTAG_DateTimeDigitized = $9004 ; 36868 (9004.H) | ASCII | 20 | None
#ExifTAG_OffsetTime = $9010 ; 36880 (9010.H) | ASCII | 7 | None ; including NULL
#ExifTAG_OffsetTimeOriginal = $9011 ; 36881 (9011.H) | ASCII | 7 | None ; including NULL
#ExifTAG_OffsetTimeDigitized = $9012 ; 36882 (9012.H) | ASCII | 7 | None ; including NULL
;
#ExifTAG_SubsecTime = $9290 ; Fractions of seconds for DateTime
#ExifTAG_SubsecTimeOriginal = $9291 ; Fractions of seconds for DateTimeOriginal
#ExifTAG_SubsecTimeDigitized = $9292 ; Fractions of seconds for DateTimeDigitized
;
#ExifTAG_ColorSpace = $A001 ; Color space information tag
#ExifTAG_PixelXDimension = $A002 ; Valid Image Width | PixelXDimension | 40962 ~ A002.H ~ SHORT or LONG ~ 1
#ExifTAG_PixelYDimension = $A003 ; Valid Image Height | PixelYDimension | 40963 ~ A003.H ~ SHORT or LONG ~ 1
EndEnumeration ; EExifTAG
; ---------------------------------------------------------------------------
Declare.i ReadExifDataFromFile(FileName$) ;
Declare FreeExifData() ;
Declare ShowResultsOnGadget(Gadget)
Declare.i GetExifTagAsInteger(ExifTag, DefaultValue = -1)
Declare.s GetExifTagAsString(ExifTag, DefaultValue$ = "")
EndDeclareModule
Module ExifData ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
EnableExplicit
; ---------------------------------------------------------------------------
; Constants
;
Enumeration EExifTAG ; Number of the TAG (Exif, TIFF, etc.)
#ExifTAG_Unsupported = $0000 ; internal define ..
#ExifTAG_ExifIFD = $8769 ; | LONG | 1 |
EndEnumeration ; EExifTAG
;
; HINT: This constant is representing the number of defined äExifTAG_Xxxx in Enumeration EExifTAG
; If you add new constants to the enumeration (local or global) you must increase the #ExifTagTableSize as well
;
#ExifTagTableSize = 29 :Debug "HINT: #ExifTagTableSize: " + #ExifTagTableSize
; ---------------------------------------------------------------------------
Enumeration EJpegMarkers
#JM_Start = $FF
; ...
#JM_SOI = $D8 ;
; ...
#JM_APP1 = $E1 ; EXIF and XMP (XMP not supported yet)
; ...
#JM_APP13 = $ED ; IPTC (not supported yet)
#JM_APP14 = $EE ; (not supported yet)
#JM_APP15 = $EF ; (not supported yet)
; ...
#JM_JPG0 = $F0 ; JPG0 == 0xF0 to JPG13 == 0xFD
#JM_COM = $FE
EndEnumeration ; EJpegMarkers
Enumeration EExifByteOrderMark
#ExifByteOderMark_Intel = $4949 ; Little-endian | 0x4D - 0x49 == 0x04 | II
#ExifByteOderMark_Motorola = $4D4D ; Big-endian | | MM
EndEnumeration ; EExifByteOrder
Enumeration EExifByteOrder
#ExifByteOrder_Motorola
#ExifByteOrder_Intel
EndEnumeration ; EExifByteOrder
; ---------------------------------------------------------------------------
#TIFF_TAG_Mark = $002A ; constant in correct byte order
#TIFF_FirstIFDOffset = $00000008 ; default offset to the first IDD
; ---------------------------------------------------------------------------
; Structure User Defined Types
;
Structure TByteArray ; Access to the Image Memory byte by byte
Byte.a[0]
EndStructure
; ---------------------------------------------------------------------------
Structure TExifTagEntry ; TAG structure for ExifTags, etc.
Number.i ;
Name$ ;
;Descr$ ; .. Description, <sorry, to much typing or formatting)
Private.i ; .. #False or #True (usage makes sense only inside module)
EndStructure
; ---------------------------------------------------------------------------
Structure TExifTagValue ; TAG structure for ExifTags, etc.
Number.i ;
Name$ ;
Caption$ ; .. display text (different language, maybe in future)
Format.i ; .. data format (type) of TAG
Private.i ; .. IsPrivate = #False or #True ??
;
AddressOffset.i ; .. address offset of the tag in the memory
AddressSize.i ; .. address size/length of the tag in the memory
;
Value.i ; .. Value, different types are supported ??
Value$ ; \ __ quick solution, needs some improvement
Array Vals.i(0) ; /
EndStructure
; ---------------------------------------------------------------------------
; Module Global Variables
;
Global *ExifData.TByteArray ; entire file is stored in this memory
Global NewList ResultValues.TExifTagValue() ; found tags need a place to wait
Global Dim ExifTagTable.TExifTagEntry(0) ; the table of TAGs we can use
; ---== Simple Helpers ==----------------------------------------------------------------------------------------------
Macro DQ
"
EndMacro
Macro ByteToHex(_Value_)
"0x" + RSet(Hex(_Value_, #PB_Byte), 2, "0") + ", (" + Str(_Value_) + ")"
EndMacro
Macro WordToHex(_Value_)
"0x" + RSet(Hex(_Value_, #PB_Word), 4, "0") + ", (" + Str(_Value_) + ")"
EndMacro
Macro LongToHex(_Value_)
"0x" + RSet(Hex(_Value_, #PB_Long), 8, "0") + ", (" + Str(_Value_) + ")"
EndMacro
Macro IntToHex(_Value_)
"0x" + RSet(Hex(_Value_, #PB_Quad), 16, "0") + ", (" + Str(_Value_) + ")"
EndMacro
; ---== Fetch BYTE, WORD, LONG, ASCII from *Memory ==------------------------------------------------------------------
; Little Endian (LE) == 8, 0; Big Endian (BE) == 0, 8
Global Dim ByteOrderWord(1, 1) ; (ByteOrderLE, Offset)
ByteOrderWord(0, 0) = 8 : ByteOrderWord(0, 1) = 0 ; <-- BE
ByteOrderWord(1, 0) = 0 : ByteOrderWord(1, 1) = 8 ; <-- LE
; Little Endian (LE) == 24, 16, 8, 0; Big Endian (BE) == 0, 8, 16, 24
Global Dim ByteOrderLong(1, 3) ; (ByteOrderLE, Offset)
ByteOrderLong(0, 0) = 24 : ByteOrderLong(0, 1) = 16 : ByteOrderLong(0, 2) = 8 : ByteOrderLong(0, 3) = 0 ; <-- BE
ByteOrderLong(1, 0) = 0 : ByteOrderLong(1, 1) = 8 : ByteOrderLong(1, 2) = 16 : ByteOrderLong(1, 3) = 24 ; <-- LE
; ---------------------------------------------------------------------------
Procedure.i FetchByte(Offset) ; return $00
ProcedureReturn *ExifData\Byte[Offset]
EndProcedure
; ---------------------------------------------------------------------------
Procedure.i FetchWord(Offset, ByteOrderLE=0) ; returns $00 00
ProcedureReturn *ExifData\Byte[Offset + 0] << ByteOrderWord(ByteOrderLE, 0) +
*ExifData\Byte[Offset + 1] << ByteOrderWord(ByteOrderLE, 1)
EndProcedure
; ---------------------------------------------------------------------------
Procedure.i FetchLong(Offset, ByteOrderLE=0) ; returns $00 00 00 00
ProcedureReturn *ExifData\Byte[Offset + 0] << ByteOrderLong(ByteOrderLE, 0) +
*ExifData\Byte[Offset + 1] << ByteOrderLong(ByteOrderLE, 1) +
*ExifData\Byte[Offset + 2] << ByteOrderLong(ByteOrderLE, 2) +
*ExifData\Byte[Offset + 3] << ByteOrderLong(ByteOrderLE, 3)
EndProcedure
; ---------------------------------------------------------------------------
Procedure.s FetchAscii(Offset, Length) ; returns value$[Length]
ProcedureReturn PeekS(*ExifData + Offset, Length, #PB_Ascii)
EndProcedure
; ---------------------------------------------------------------------------
Procedure.s GetByteOrderName(ByteOrder)
Select ByteOrder
Case #ExifByteOrder_Motorola : ProcedureReturn "Motorola"
Case #ExifByteOrder_Intel : ProcedureReturn "Intel"
EndSelect
ProcedureReturn ""
EndProcedure
; ---------------------------------------------------------------------------
Procedure LogOut(Message$) ; @ Todo: further improvements
Debug "LOG -> " + Message$
EndProcedure
; ---------------------------------------------------------------------------
; temp marco for use in the next procedure only
Macro _setTagEntry(_ConstantName_, _Private_) ; _Private_ == #False or #True
ExifTagTable(Index)\Number = _ConstantName_
ExifTagTable(Index)\Name$ = Mid(DQ#_ConstantName_#DQ, 11) ; cut off #ExifTAG_ constant prefix
ExifTagTable(Index)\Private = _Private_
Index + 1
EndMacro
;
Procedure InitializeExifTagTable() ; fill the table with supported TAGs
Protected Index = 0
Dim ExifTagTable(#ExifTagTableSize) ; constant avoid redim at the end
; internal used constants
_setTagEntry(#ExifTAG_Unsupported , #False) ; internal stuff ??
_setTagEntry(#ExifTAG_ImageWidth , #False)
_setTagEntry(#ExifTAG_ImageHeight , #False)
_setTagEntry(#ExifTAG_BitsPerSample , #False)
_setTagEntry(#ExifTAG_Compression , #False)
_setTagEntry(#ExifTAG_Orientation , #False)
_setTagEntry(#ExifTAG_XResolution , #False)
_setTagEntry(#ExifTAG_YResolution , #False)
_setTagEntry(#ExifTAG_ResolutionUnit , #False)
_setTagEntry(#ExifTAG_ImageDescription , #False) ; new
_setTagEntry(#ExifTAG_Make , #False)
_setTagEntry(#ExifTAG_Model , #False)
_setTagEntry(#ExifTAG_Software , #False)
_setTagEntry(#ExifTAG_DateTime , #False)
_setTagEntry(#ExifTAG_Artist , #False)
_setTagEntry(#ExifTAG_Copyright , #False)
_setTagEntry(#ExifTAG_ExifIFD , #True) ; offset to IFD (Image File Directory)
_setTagEntry(#ExifTAG_ExifVersion , #False)
_setTagEntry(#ExifTAG_ExifFlashpixVersion, #False)
_setTagEntry(#ExifTAG_DateTimeOriginal , #False)
_setTagEntry(#ExifTAG_DateTimeDigitized , #False)
_setTagEntry(#ExifTAG_OffsetTime , #False)
_setTagEntry(#ExifTAG_OffsetTimeOriginal , #False)
_setTagEntry(#ExifTAG_OffsetTimeDigitized, #False)
_setTagEntry(#ExifTAG_SubsecTime , #False)
_setTagEntry(#ExifTAG_SubsecTimeOriginal , #False)
_setTagEntry(#ExifTAG_SubsecTimeDigitized, #False)
_setTagEntry(#ExifTAG_ColorSpace , #False)
_setTagEntry(#ExifTAG_PixelXDimension , #False)
_setTagEntry(#ExifTAG_PixelYDimension , #False)
If Index - 1 <> #ExifTagTableSize
Debug "INTERNAL INFO: ARRAY SIZE is redimmed to " + Str(Index-1) + " constant = " + #ExifTagTableSize
; optimize the memory usage
ReDim ExifTagTable(Index-1) ; the number of Tags we can use
EndIf
; for binary search the numbers must be sorted
SortStructuredArray(ExifTagTable(), 0, OffsetOf(TExifTagEntry\Number), TypeOf(TExifTagEntry\Number))
; Debug #LF$+"Show ExifTagTable "
; For Index = 0 To #ExifTagTableSize
; Debug " " + index + ". " + ExifTagTable(Index)\Name$ + ", 0x" + Hex(ExifTagTable(Index)\Number) + ", " + ExifTagTable(Index)\Private
; Next Index
; Debug ""
EndProcedure
;
UndefineMacro _setTagEntry
;
InitializeExifTagTable() ; call it directly to fill the arrays
; ---------------------------------------------------------------------------
Procedure.i GetExifTagIndex(Number) ; returns index or -1
; >> Iterative Binary Search -- faster than Linear or Sequential search on sorted arrays
Protected retIdx, firstIdx, lastIdx, midIdx ;:Debug #LF$+#PB_Compiler_Procedure+"(0x"+Hex(Number)+")", 9
retIdx = -1 ; default return value == -1
firstIdx = 0 ; start search with entire array
lastIdx = ArraySize(ExifTagTable()) ; -"-
While lastIdx - firstIdx > 1
midIdx = (lastIdx + firstIdx) / 2 ;:Debug " iterate: " + firstIdx + ", " + lastIdx + ", " + midIdx, 9
If ExifTagTable(midIdx)\Number < Number
firstIdx = midIdx + 1
Else
lastIdx = midIdx
EndIf
Wend
If ExifTagTable(firstIdx)\Number = Number
retIdx = firstIdx
ElseIf ExifTagTable(lastIdx)\Number = Number
retIdx = lastIdx
EndIf ;:Debug "Found 0x" + Hex(Number) + " at Index " + retIdx, 9
ProcedureReturn retIdx ; return -1 (not found) or index (0..ArraySize())
EndProcedure
; ---------------------------------------------------------------------------
Procedure.i ParseTagValue(entryOffset, tiffStart, byteOrderLE)
Protected fmt, numValues, valueOffset, offset, n, numerator, denominator :Debug #LF$+#PB_Compiler_Procedure+"()", 9
Protected ret_val, tmp$, v.f
fmt = FetchWord(entryOffset + 2, byteOrderLE) ;.. acc. to spec.
numValues = FetchLong(entryOffset + 4, byteOrderLE) ;..
valueOffset = FetchLong(entryOffset + 8, byteOrderLE) + tiffStart ;..
ResultValues()\Format = fmt ;
Select fmt
Case 1, 7 ;// 1 -> byte, 8-bit unsigned int .. 7 -> undefined, 8-bit byte, value depending on field
If numValues = 1
ResultValues()\Value = FetchByte(entryOffset + 8)
Else
If numValues > 4 : offset = valueOffset : Else : offset = entryOffset + 8 : EndIf
ResultValues()\Value$ = FetchAscii(offset, numValues) ; numValues == 4
EndIf
; keep the position (address) of the value to overwrite with new data ????
ResultValues()\AddressOffset = offset
ResultValues()\AddressSize = numValues
ret_val = #True
Case 2 ;// 2 -> ascii, 8-bit byte
If numValues > 4 : offset = valueOffset : Else : offset = entryOffset + 8 : EndIf
ResultValues()\Value$ = FetchAscii(offset, numValues - 1)
; keep the position (address) of the value to overwrite with new data ????
ResultValues()\AddressOffset = offset
ResultValues()\AddressSize = numValues - 1 ; different (because no trailing ZERO)
ret_val = #True
Case 3 ;// 3 -> short, 16 bit int
If numValues = 1
ResultValues()\Value = FetchWord(entryOffset + 8, byteOrderLE)
Else
If numValues > 2 : offset = valueOffset : Else : offset = entryOffset + 8 : EndIf
ReDim ResultValues()\Vals(numValues)
For n = 0 To numValues - 1
ResultValues()\Vals(n) = FetchWord(offset + 2 * n, byteOrderLE)
Next n
EndIf
; keep the position (address) of the value to overwrite with new data ????
ResultValues()\AddressOffset = offset
ResultValues()\AddressSize = numValues - 1
ret_val = #True
Case 4 ;// 4 -> long, 32 bit int
If numValues = 1
ResultValues()\Value = FetchLong(entryOffset + 8, byteOrderLE)
Else
ReDim ResultValues()\Vals(numValues)
For n = 0 To numValues - 1
ResultValues()\Vals(n) = FetchLong(offset + 4 * n, byteOrderLE)
Next n
EndIf
; keep the position (address) of the value to overwrite with new data ????
ResultValues()\AddressOffset = offset
ResultValues()\AddressSize = numValues - 1
ret_val = #True
Case 5 ;// 5 -> rational = two long values, first is numerator, second is denominator
If numValues = 1
numerator = FetchLong(valueOffset, byteOrderLE)
denominator = FetchLong(valueOffset + 4, byteOrderLE)
v = numerator / denominator
ResultValues()\Value$ = StrF(v)
Else
For n = 0 To numValues - 1
numerator = FetchLong(valueOffset + 8*n, byteOrderLE)
denominator = FetchLong(valueOffset + 4 + 8*n, byteOrderLE)
v = numerator / denominator
ResultValues()\Value$ + StrF(v) + ";" ; ??
Next n
EndIf
;ResultValues()\Private = #True ; don't share, not verified by now
ret_val = #False ; not supported yet.
Case 9 ;// 9 ; slong, 32 bit signed int
If numValues = 1
ResultValues()\Value = FetchLong(entryOffset + 8, byteOrderLE) & $FFFF ; ??
Else
ReDim ResultValues()\Vals(numValues)
For n = 0 To numValues - 1
ResultValues()\Vals(n) = FetchLong(offset + 4 * n, byteOrderLE) & $FFFF ; ??
Next n
EndIf
; keep the position (address) of the value to overwrite with new data ????
ResultValues()\AddressOffset = offset
ResultValues()\AddressSize = numValues - 1
ret_val = #True
Case 10 ;// 10 -> signed rational, two slongs, first is numerator, second is denominator
If numValues = 1
ResultValues()\Value = FetchLong(valueOffset, byteOrderLE) / FetchLong(valueOffset+4, byteOrderLE) ;??
Else
ReDim ResultValues()\Vals(numValues)
For n = 0 To numValues - 1
ResultValues()\Vals(n) = FetchLong(valueOffset + 8*n, byteOrderLE) / FetchLong(valueOffset+4 + 8*n, byteOrderLE) ;??
Next n
EndIf
;ResultValues()\Private = #True ; don't share, not verified by now
ret_val = #False ; not supported yet.
EndSelect
ProcedureReturn ret_val
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure.i ParseTags(tiffStart, dirStart, byteOrderLE) ;
Protected entries, entryOffset, tag, ii, idx, name$ :Debug #LF$+#PB_Compiler_Procedure+"()", 9
Protected ret_val
entries = FetchWord(dirStart, byteOrderLE) :Debug " entries = " + entries, 9
For ii = 0 To entries - 1
entryOffset = dirStart + ii * 12 + 2 ;.. calulation acc. to specification -- jump over unsupported tags
tag = FetchWord(entryOffset, byteOrderLE)
idx = GetExifTagIndex(tag) ; look for TAG in the ExifTagTable()
If idx = -1
; ##_TAG_##
; ; Log all available but not supported Tags
; LogOut("TAG: " + WordToHex(tag) + " not supported!")
Continue ; with the next tag
EndIf
; work on supported TAGs
AddElement(ResultValues())
ResultValues()\Number = tag ; copy TAG Number ...
ResultValues()\Name$ = ExifTagTable(idx)\Name$ ; ... and name$
ResultValues()\Private = ExifTagTable(idx)\Private ; ... and private flag
;;LogOut("TAG: " + WordToHex(tag) + " " + ExifTagTable(idx)\Name$ + " supported!")
ret_val | ParseTagValue(entryOffset, tiffStart, byteOrderLE) ; one valid tag is enough :)
Next ii
ProcedureReturn ret_val
EndProcedure
; -----------------------------------------------------------------------------
Procedure.i ParseEXIFData(Start)
Protected byteOrderLE, tags, tag, exifData, gpsData, tiffOffset :Debug #LF$+#PB_Compiler_Procedure+"()", 9
Protected firstIFD_offset, ExifIFD_offset
Protected ret_val, rc
If FetchAscii(Start, 4) <> "Exif"
LogOut("Not valid EXIF data! " + FetchAscii(Start, 4))
ProcedureReturn #False
EndIf
tiffOffset = Start + 6 ; kept for further investigation
; test for TIFF validity and byte order
If FetchWord(tiffOffset) = #ExifByteOderMark_Intel ; 0x4949 == Intel Byte Order
byteOrderLE = #True ; .. \-> little endian
ElseIf FetchWord(tiffOffset) = #ExifByteOderMark_Motorola ; 0x4D4D == Motorola Byte Order
byteOrderLE = #False ; .. \-> big endian
Else
LogOut("Not valid TIFF data! (no 0x4949 or 0x4D4D)")
ProcedureReturn #False ;.. failure because of unknown byteorder!
EndIf
If FetchWord(tiffOffset + 2, byteOrderLE) <> #TIFF_TAG_Mark ; 0x002A == TIFF_TAG_Mark
LogOut("Not valid TIFF data! (no 0x002A)")
ProcedureReturn #False
EndIf
firstIFD_offset = FetchLong(tiffOffset + 4, byteOrderLE)
If firstIFD_offset < #TIFF_FirstIFDOffset ; == 0x00000008 (Default offset)
LogOut("Not valid TIFF data! (First offset less than 8) " + FetchLong(tiffOffset + 4, byteOrderLE))
ProcedureReturn #False ; failure
EndIf
ret_val = ParseTags(tiffOffset, tiffOffset + firstIFD_offset, byteOrderLE) ;; ### TiffTags --> ARRAY or MAP ????
If ret_val
If ResultValues()\Number = #ExifTAG_ExifIFD ; <--> 0x8769 == ExifIFD pointer
ExifIFD_offset = ResultValues()\Value
; Debug "HINT: ExifIFD-Offset = " + ExifIFD_offset + " // parse tags "
rc = ParseTags(tiffOffset, tiffOffset + ExifIFD_offset, byteOrderLE) ;
; .. needs some further investigation ..
EndIf
EndIf
ProcedureReturn ret_val
EndProcedure
; ---== Read, Write, Free ImageFile and *Memory ==---------------------------------------------------------------------
Procedure.i ReadExifDataFromFile(FileName$) ;
Protected FILE, memsize, bytes :Debug #LF$+#PB_Compiler_Procedure+"("+FileName$+")", 9
Protected offset, marker
FreeExifData()
ClearList(ResultValues())
FILE = ReadFile(#PB_Any, FileName$) ; read with no flags
If FILE
memsize = Lof(FILE) ; Lof .. Length of (opened) file
*ExifData = AllocateMemory(memsize) ; returns the address, or zero if the memory cannot be allocated
If *ExifData
bytes = ReadData(FILE, *ExifData, memsize) ; read all data into memory block
LogOut("Read file with length of " + Str(bytes) + " bytes. ")
EndIf
CloseFile(FILE)
Else
*ExifData = 0 ;
LogOut("ERROR: Couldn't open the file '" + FileName$ + "'")
ProcedureReturn #False ; not a valid image (jpeg) file
EndIf
; analyze file from the beginning
If FetchByte(0) <> #JM_Start Or FetchByte(1) <> #JM_SOI ;.. == FFD8
LogOut("Not a valid JPEG")
ProcedureReturn #False ; not a valid jpeg
EndIf
offset = 2 ; jump over the first two bytes :)
While offset < memsize ; scan the file memory byte by byte for find the marker 0xFFE1
If FetchByte(offset) <> #JM_Start
LogOut("Not a valid marker at offset " + offset + ", found: " + FetchByte(offset))
ProcedureReturn #False ; not a valid marker, something is wrong
EndIf
marker = FetchByte(offset + 1)
; we could implement handling for other markers here, but we're only looking for 0xFFE1 for EXIF data
If marker = #JM_APP1 ; == 225 = $E1
LogOut("Found 0xFFE1 marker")
ProcedureReturn ParseEXIFData(offset + 4)
Else
offset + 2 + FetchWord(offset + 2)
EndIf
Wend
ProcedureReturn #False ; return failure, could not found a valid marker
EndProcedure
; ---------------------------------------------------------------------------
Procedure FreeExifData() ;
If *ExifData <> 0 :Debug #LF$+#PB_Compiler_Procedure+"() // in use, clear it first.", 9
FreeMemory(*ExifData) ; in use, free memory first
*ExifData = 0
EndIf
EndProcedure
; ---------------------------------------------------------------------------
Procedure ShowResultsOnGadget(Gadget) ; Gadget is a #ListIcon and has two (2) columns
Protected txt$, ii
If IsGadget(Gadget) And GadgetType(Gadget) = #PB_GadgetType_ListIcon And GetGadgetAttribute(Gadget, #PB_ListIcon_ColumnCount) = 2
; Debug #LF$+"ResultValues(): "
ForEach ResultValues()
; Debug " " + ResultValues()\Name$ + " " + ResultValues()\Value + " | '" + ResultValues()\Value$ + "' | ... "
If ResultValues()\Private = #True ; <--> for internal use only :)
Continue
EndIf
; Debug " " + ResultValues()\Name$ + " " + ResultValues()\Value + " | '" + ResultValues()\Value$ + "' | ... "
If ResultValues()\Value$ <> ""
txt$ = ResultValues()\Value$
ElseIf ResultValues()\Value <> 0
txt$ = Str(ResultValues()\Value)
Else
For ii = 0 To ArraySize(ResultValues()\Vals()) - 1
txt$ + Str(ResultValues()\Vals(ii)) + ";"
Next ii
EndIf
AddGadgetItem(Gadget, -1, ResultValues()\Name$ + #LF$ + txt$)
Next
Else ; not the correct gadget
Debug "INTERNAL: Gadget " + Gadget + " is not the correct gadget type. "
EndIf
EndProcedure
; ---------------------------------------------------------------------------
Procedure.i GetExifTagAsInteger(ExifTag, DefaultValue = -1)
ForEach ResultValues()
If ResultValues()\Number = ExifTag
ProcedureReturn ResultValues()\Value
EndIf
Next
ProcedureReturn DefaultValue
EndProcedure
; ---------------------------------------------------------------------------
Procedure.s GetExifTagAsString(ExifTag, DefaultValue$ = "")
ForEach ResultValues()
If ResultValues()\Number = ExifTag
ProcedureReturn ResultValues()\Value$
EndIf
Next
ProcedureReturn DefaultValue$
EndProcedure
; ---------------------------------------------------------------------------
; Procedure GetExifTagValue(ExifTag)
; EndProcedure
; ---------------------------------------------------------------------------
EndModule ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; ---== MainWindow ==--------------------------------------------------------------------------------------------------
Procedure ShowImagePreview(FileName$) ; update all UI gadgets
Protected IMAGE
Protected ix, iy, iw, ih, gw, gh, txt$
gw = GadgetWidth(#GADGET_CnvPreView) ; <-- get the size of the image gadget
gh = GadgetHeight(#GADGET_CnvPreView)
If FileSize(FileName$) > 0 ; FileName$ = "" returns -1 as well
IMAGE = LoadImage(#PB_Any, FileName$) ; <-- load image
EndIf
If IMAGE
iw = ImageWidth(IMAGE)
ih = ImageHeight(IMAGE)
txt$ = "Image Size = " + Str(iw) + " x " + Str(ih)
; calc factor to reduce to the available gadget size
ix = 1 : While iw/ix > gw : ix + 1 : Wend
iy = 1 : While ih/iy > gh : iy + 1 : Wend
If ix < iy : ix = iy : EndIf ; the bigger the better :)
iw / ix : ih / ix ; shrink the size
; center in hori and verti orientation
ix = (gw - iw) / 2 : If ix < 0 : ix = 0 : EndIf
iy = (gh - ih) / 2 : If iy < 0 : iy = 0 : EndIf
Else ; <-- default ??
txt$ = "Image: Nothing selected or found!"
EndIf
If StartDrawing(CanvasOutput(#GADGET_CnvPreView))
Box(0, 0, gw, gh, #White)
If IMAGE ; <-- valid image
DrawImage(ImageID(IMAGE), ix, iy, iw, ih)
EndIf
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(4, 4, txt$, #Blue)
StopDrawing()
EndIf
If IMAGE
FreeImage(IMAGE)
EndIf
EndProcedure
;-----------------------------------------------------------------------------
Procedure UpdateImage(FileName$)
If FileName$ And ExifData::ReadExifDataFromFile(FileName$)
ExifData::ShowResultsOnGadget(#GADGET_LstImageInfo)
ExifData::FreeExifData()
Else ; do some info
AddGadgetItem(#GADGET_LstImageInfo, -1, "No Exif-Info!")
EndIf
ShowImagePreview(FileName$)
EndProcedure
; -----------------------------------------------------------------------------
Procedure ResizeGadgetsWindow_0()
Protected FormWindowWidth, FormWindowHeight
FormWindowWidth = WindowWidth(#WINDOW_Main)
FormWindowHeight = WindowHeight(#WINDOW_Main)
ResizeGadget(#GADGET_ExpImageFiles, 20, 20, 240, FormWindowHeight - 180)
ResizeGadget(#GADGET_LstImageInfo, 270, 20, 320, FormWindowHeight - 180)
ResizeGadget(#GADGET_CnvPreView, 600, 20, FormWindowWidth - 620, FormWindowHeight - 250)
ResizeGadget(#GADGET_EdtPreView, 600, FormWindowHeight - 220, FormWindowWidth - 620, 60)
ResizeGadget(#GADGET_Source_path, 20, FormWindowHeight - 130, 70, 25)
ResizeGadget(#GADGET_Source_path_show, 100, FormWindowHeight - 130, FormWindowWidth - 570, 25)
ResizeGadget(#GADGET_Target_path, 20, FormWindowHeight - 100, 70, 25)
ResizeGadget(#GADGET_Target_path_show, 100, FormWindowHeight - 100, FormWindowWidth - 570, 25)
ResizeGadget(#Frame3D_0, 10, 0, FormWindowWidth - 20, FormWindowHeight - 150)
ResizeGadget(#Frame3D_1, 10, FormWindowHeight - 150, FormWindowWidth - 20, 80)
ResizeGadget(#Frame3D_2, 10, FormWindowHeight - 70, FormWindowWidth - 20, 60)
ResizeGadget(#GADGET_Original_file, FormWindowWidth - 460, FormWindowHeight - 130, 120, 25)
ResizeGadget(#GADGET_Original_file_show, FormWindowWidth - 330, FormWindowHeight - 130, 310, 25)
ResizeGadget(#GADGET_Renamed_file, FormWindowWidth - 460, FormWindowHeight - 100, 120, 25)
ResizeGadget(#GADGET_Renamed_file_show, FormWindowWidth - 330, FormWindowHeight - 100, 310, 25)
ResizeGadget(#GADGET_Button_exit, 20, FormWindowHeight - 50, 180, 25)
ResizeGadget(#GADGET_Button_rename, FormWindowWidth - 200, FormWindowHeight - 50, 180, 25)
ResizeGadget(#GADGET_Button_rename_abort, FormWindowWidth - 400, FormWindowHeight - 50, 180, 25)
EndProcedure
; -----------------------------------------------------------------------------
Procedure OpenMainWindow(WndW, WndH) ;
If OpenWindow(#WINDOW_Main, 0, 0, 1120, 750, "", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
StickyWindow(#WINDOW_Main, 1) ; always on top, my sreen is a mess :)
FrameGadget(#Frame3D_0, 10, 0, 1100, 600, "")
FrameGadget(#Frame3D_1, 10, 600, 1100, 80, "")
FrameGadget(#Frame3D_2, 10, 680, 1100, 60, "")
ExplorerListGadget(#GADGET_ExpImageFiles, 20, 20, 240, 570, "C:\Users\Rainer\Pictures\*.jpg", #PB_Explorer_AlwaysShowSelection | #PB_Explorer_FullRowSelect)
RemoveGadgetColumn(#GADGET_ExpImageFiles, 1) ; we don't need the other columns
RemoveGadgetColumn(#GADGET_ExpImageFiles, 1) ; -"-
RemoveGadgetColumn(#GADGET_ExpImageFiles, 1) ; -"-
SetGadgetItemAttribute(#GADGET_ExpImageFiles, 0, #PB_Explorer_ColumnWidth, 216, 0)
SetGadgetItemState(#GADGET_ExpImageFiles, 0, #PB_Explorer_Selected | #PB_Explorer_AlwaysShowSelection | #PB_Explorer_FullRowSelect )
ListIconGadget(#GADGET_LstImageInfo, 270, 20, 320, 570, "Name", 120, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_GridLines)
AddGadgetColumn(#GADGET_LstImageInfo, 1, "Value", 200-24)
CanvasGadget(#GADGET_CnvPreView, 600, 20, 500, 500, #PB_Canvas_Border)
EditorGadget(#GADGET_EdtPreView , 600, 530, 500, 60, #PB_Editor_WordWrap|#PB_Editor_ReadOnly)
SetGadgetText(#GADGET_EdtPreView, "No Selected Value!")
TextGadget(#GADGET_Source_path, 20, 620, 70, 25, "Quell-Pfad:", #PB_Text_Right)
TextGadget(#GADGET_Source_path_show, 100, 620, 550, 25, "", #PB_Text_Border)
TextGadget(#GADGET_Target_path, 20, 650, 70, 25, "Ziel-Pfad:", #PB_Text_Right)
TextGadget(#GADGET_Target_path_show, 100, 650, 550, 25, "", #PB_Text_Border)
TextGadget(#GADGET_Original_file, 660, 620, 120, 25, "Original-Dateiname:", #PB_Text_Right)
TextGadget(#GADGET_Original_file_show, 790, 620, 310, 25, "", #PB_Text_Border)
TextGadget(#GADGET_Renamed_file, 660, 650, 120, 25, "Renamed-Dateiname:", #PB_Text_Right)
TextGadget(#GADGET_Renamed_file_show, 790, 650, 310, 25, "", #PB_Text_Border)
ButtonGadget(#GADGET_Button_exit, 20, 700, 180, 25, "Programm beenden")
ButtonGadget(#GADGET_Button_rename, 920, 700, 180, 25, "Bilder umbennen starten")
ButtonGadget(#GADGET_Button_rename_abort, 720, 700, 180, 25, "Bilder umbennen abbrechen")
DisableGadget(#GADGET_Button_rename_abort, #True)
ProcedureReturn 1 ; success
EndIf
ProcedureReturn 0 ; failure
EndProcedure
; ---------------------------------------------------------------------------
; MISTAKE !!!!
; In this Procedure I want to work down the exlorerlist-entries 1 by 1 from top to bottom.
; If it is a jpg-file I want to show the picture and want to show the exif-Data in the listbox.
; In the next step I want to read the DateTimeDigitized or the DateTimeOriginal-date to
; copy the picture into the created folder "Date-Renamed" under a new name like this: "Digitized_date-Filename.ext"
; But it does not work the wanted!
; The list will be worked down 1 by 1 >> OK
; The picture will be shown in the Canvas >> OK
; The selected filename should be highlighted >> will not be done!!
; The Exif-date should be shown in the listbox >> will not be done!!
; The Rename-abort-button will not be recognized >> no abort action in the While-wend loop happens, the loop will not be ended!
Procedure Rename_Pictures()
Protected File_Loop.i = 0, Rename_FileName.s, Exif_Date.s, File_Extension.s, Items_in_Folder.i = 0, List_File.s
Rename_Abort = 0
Items_in_Folder = CountGadgetItems(#GADGET_ExpImageFiles)
ClearGadgetItems(#GADGET_LstImageInfo)
While Items_in_Folder > File_Loop Or Rename_Abort = 1
SetGadgetItemState(#GADGET_ExpImageFiles, File_Loop, #PB_Explorer_Selected )
List_File = GetGadgetText(#GADGET_ExpImageFiles) + GetGadgetItemText(#GADGET_ExpImageFiles, File_Loop, 0)
If Not FileSize(List_File) = -2 ;Nur Dateinamen werden bearbeitet, keine Verzeichnisse
Only_Filename = GetFilePart(List_File)
File_Extension = UCase(GetExtensionPart(Only_filename))
If (File_Extension = "JPG") ;Or (File_Extension = "PNG") Or (File_Extension = "BMP")
ClearGadgetItems(#GADGET_LstImageInfo)
UpdateImage(List_File)
Exif_Date = "Exif_Date-" ;Get Exif_Date
Rename_FileName = Exif_Date + Only_filename
CopyFile(List_File, Rename_Path + "\" + Rename_FileName)
SetGadgetText(#GADGET_Original_file_show, Only_Filename)
SetGadgetText(#GADGET_Renamed_file_show, Rename_FileName)
EndIf
EndIf
Delay(100)
File_Loop + 1
Wend
DisableGadget(#GADGET_Button_rename_abort, #True)
DisableGadget(#GADGET_Button_exit, #False)
DisableGadget(#GADGET_Button_rename, #False)
EndProcedure
; ---== main program ==------------------------------------------------------------------------------------------------
Procedure main()
Protected WndW = 1120, WndH = 750
InitKeyboard()
ExamineDesktops()
If DesktopWidth(0) < WndW Or DesktopHeight(0) < WndH
MessageRequester("Display Information", "Your current resolution is to small for this application!")
WndW = 800 : WndH = 600
EndIf
If OpenMainWindow(WndW, WndH)
If FileSize("C:\Temp\camera") = -2 ; existing directory ... some test pictures exists on my computer
SetGadgetText(#GADGET_ExpImageFiles, "C:\Temp\camera\*.jpg")
EndIf
Repeat ; <--- main loop ---
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break ; say good bye
Case #PB_Event_SizeWindow
ResizeGadgetsWindow_0()
Case #PB_Event_Gadget
Select EventGadget()
Case #GADGET_ExpImageFiles ; Explorer with Images
Select EventType()
Case #PB_EventType_Change
ClearGadgetItems(#GADGET_LstImageInfo)
index = GetGadgetState(#GADGET_ExpImageFiles)
SetGadgetText(#GADGET_Source_path_show, GetGadgetText(#GADGET_ExpImageFiles))
If index > -1
file = GetGadgetText(#GADGET_ExpImageFiles) + GetGadgetItemText(#GADGET_ExpImageFiles, index, 0)
If Not FileSize(file) = -2 ;Nur Dateinamen werden gezeigt, keine Verzeichnisse
Only_Filename = GetFilePart(file)
SetGadgetText(#GADGET_Original_file_show, Only_Filename)
Else
SetGadgetText(#GADGET_Original_file_show, "")
EndIf
Else ; update image section anyway
file = ""
EndIf
UpdateImage(file)
SetGadgetText(#GADGET_EdtPreView, "No Selected Value!")
EndSelect
Case #GADGET_LstImageInfo ; Info of selected Image
Select EventType()
Case #PB_EventType_Change
index = GetGadgetState(#GADGET_LstImageInfo)
If index > -1
SetGadgetText(#GADGET_EdtPreView, GetGadgetItemText(#GADGET_LstImageInfo, index, 1))
Else
SetGadgetText(#GADGET_EdtPreView, "No Selected Value!")
EndIf
EndSelect
Case #GADGET_Button_rename
Select EventType()
Case #PB_EventType_LeftClick
DisableGadget(#GADGET_Button_rename_abort, #False)
DisableGadget(#GADGET_Button_exit, #True)
DisableGadget(#GADGET_Button_rename, #True)
Rename_Path = GetGadgetText(#GADGET_ExpImageFiles) + "\Date_Renamed" ; Rename_Path_Namen erstellen
If FileSize(Rename_Path) = -1 ;Prüfen ob der RenamePfad schon existiert
If CreateDirectory(Rename_Path) ; Pfad wird erstellt
MessageRequester("Information", "Rename-Pfad zum Quell-Verzeichnis wurde erstellt", #PB_MessageRequester_Ok | #PB_MessageRequester_Info)
SetGadgetText(#GADGET_Target_path_show, Rename_Path)
Rename_Pictures()
EndIf
ElseIf FileSize(Rename_Path) = -2
MessageRequester("Information", "Rename-Pfad zum Quell-Verzeichnis ist bereits vorhanden", #PB_MessageRequester_Ok | #PB_MessageRequester_Info)
SetGadgetText(#GADGET_Target_path_show, Rename_Path)
Rename_Pictures()
EndIf
EndSelect
Case #GADGET_Button_exit
Select EventType()
Case #PB_EventType_LeftClick
Break ; say good bye
EndSelect
Case #GADGET_Button_rename_abort
Select EventType()
Case #PB_EventType_LeftClick
Debug "Abbruch!"
Rename_Abort = 1
EndSelect
EndSelect ; EventGadget()
EndSelect ; WaitWindowEvent()
ForEver ; <-- main loop end
EndIf ; OpenMainWindow()
ProcedureReturn 0
EndProcedure
; ---------------------------------------------------------------------------
End main()
;----== Bottom of File ==----------------------------------------------------------------------------------------------
