ich hoffe irgendwer aus der PureBasic-Gemeinde kann mir helfen und findet meinen Fehler.
Kurze Beschreibung was das Programm machen soll:
Nach meinen Reisen mache ich meine Urlaubsfilme, in denen immer chronolgisch die Reise gezeigt wird.
Da ich die Bilder und Videos mit mehreren Kameras mache, (Fotocamera, mein Pixel-Handy, IPhone meiner Frau) haben leider alle Bilder verschiedene Dateinamen-Strukturen. Mal ist das Aufnahmedatum im Filename mal nicht. Aber alle haben Exif-Daten! Das Sortieren unter Win10 nach Aufnahmedatum ist nicht wirklich zu gebrauchen. leider!
Um die Bilder im Projektfolder für das Urlaubsvideo in der chronologischen Reihenfolge zu haben möchte ich aller Bilder wie folgt in einen "Date-Renamed"-Folder unter dem Original-Folder kopieren:
- Falls unter dem Original-Folder noch kein Date-Renamed-Folder besteht, wird er erstellt >>> funktioniert!
- Dann wird der Selectbalken auf den ersten Eintrag in der Folder Liste gesetzt >>> Funktioniert leider nicht wie gewünscht.
- Danach wird der Folder Datei für Datei in einer While-Wend-Schleife abgearbeitet und wenn der Eintrag ein Bild ist wird es gezeigt, die Exif-Daten ausgelesen >>> wobei die Anzeige funktioniert, das Auslesen vielleicht, aber das füllen der Listbox mit den Exifdaten funktioniert nicht!
- Der Folder wird komplett durchgearbeitet >> Funktioniert, denn jedes Bild wird im Preview-Bereich gezeigt.
- Aber die Exif-Daten, wenn sie denn richtig gelesen werden (kann ich nicht nachvollziehen!) >>> werden nicht gezeigt!
- Die Schleife soll eigentlich über den Button "Bilder umbenennen abbrechen" abgebrochen werden >>> funktioniert auch nicht.
Klicke ich einen Dateinamen in der Explorerliste an, funktioniert die Anzeige der Exif-Daten einwandfrei. Gleiche Prozedur wird in der While-Wend-Schleife aufgerufen und funktioniert nicht!
IM Source-Code nach "MISTAKE" suchen dann ist man in der Prozedure die nicht so funktioniert wie sie soll!
Für Eure Hilfe bedanke ich mich schon mal im voraus.
Rainer
Hier mein Code, der auf einem Code aus dem englische Forum basiert.
Code: Alles auswählen
;/=====================================================================================================================
;| 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
; ---== 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
SetGadgetItemState(#GADGET_ExpImageFiles, 0, #PB_Explorer_Selected )
Items_in_Folder = CountGadgetItems(#GADGET_ExpImageFiles)
ClearGadgetItems(#GADGET_LstImageInfo)
While Items_in_Folder > File_Loop
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case #GADGET_Button_rename_abort
Select EventType()
Case #PB_EventType_LeftClick
Break
EndSelect
EndSelect
EndSelect
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
SetGadgetText(#GADGET_Original_file_show, Only_Filename)
SetGadgetText(#GADGET_Renamed_file_show, Rename_FileName)
Delay(1000)
EndIf
EndIf
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
Rename_Abort = 1
EndSelect
EndSelect ; EventGadget()
EndSelect ; WaitWindowEvent()
ForEver ; <-- main loop end
EndIf ; OpenMainWindow()
ProcedureReturn 0
EndProcedure
; ---------------------------------------------------------------------------
End main()
;----== Bottom of File ==----------------------------------------------------------------------------------------------