Procedure wird nicht abgearbeitet
Re: Procedure wird nicht abgearbeitet
Ok,
ich habe Deinen Code nochmals eingefügt, das Delay (wollte das Bild länger sehen und die Exif-Daten ansehen!) herausgenommen. Nun funktioniert es auch bei mir. Auf das Abbrechen kann man auch eigentlich verzichten, denn jetzt tut es ja das was es soll.
Danke soweit
Rainer
ich habe Deinen Code nochmals eingefügt, das Delay (wollte das Bild länger sehen und die Exif-Daten ansehen!) herausgenommen. Nun funktioniert es auch bei mir. Auf das Abbrechen kann man auch eigentlich verzichten, denn jetzt tut es ja das was es soll.
Danke soweit
Rainer
Re: Procedure wird nicht abgearbeitet
Zuerst ist der Exif-Code nur sehr rudimentär mit ein paar wenigen jpeg's getestet. Das führt leider dazu, dass - wie ich mittlerweile weiß - viele jpg-Formate nicht erkannt werden. Hier werde ich wohl (irgenwann) noch mal Hand anlegen müssen.
Die Debug Ausgabe zeigt das bei einigen Dateien.
Zweitens (wie NicTheQuick schon geschrieben hat) kann/sollte man WaitWindowEvent() oder WindowEvent() nicht mehrfach einsetzen. Für derartige Schleifen bieten sich Statemachines (über Timer-Events) oder Threads an. Das ist ein Problem ausserhalb des Exif-Codes.
Die Debug Ausgabe zeigt das bei einigen Dateien.
Zweitens (wie NicTheQuick schon geschrieben hat) kann/sollte man WaitWindowEvent() oder WindowEvent() nicht mehrfach einsetzen. Für derartige Schleifen bieten sich Statemachines (über Timer-Events) oder Threads an. Das ist ein Problem ausserhalb des Exif-Codes.
Using PureBasic latest stable version and current alpha/beta (x64) on Windows 11 Home
Re: Procedure wird nicht abgearbeitet
Hallo,Axolotl hat geschrieben: 29.06.2023 16:43 Zuerst ist der Exif-Code nur sehr rudimentär mit ein paar wenigen jpeg's getestet. Das führt leider dazu, dass - wie ich mittlerweile weiß - viele jpg-Formate nicht erkannt werden. Hier werde ich wohl (irgenwann) noch mal Hand anlegen müssen.
Die Debug Ausgabe zeigt das bei einigen Dateien.
Zweitens (wie NicTheQuick schon geschrieben hat) kann/sollte man WaitWindowEvent() oder WindowEvent() nicht mehrfach einsetzen. Für derartige Schleifen bieten sich Statemachines (über Timer-Events) oder Threads an. Das ist ein Problem ausserhalb des Exif-Codes.
ja, das ist mir auch bekannt, mache ich sonst nicht, aber hier hat es Quick and dirty zum Erfolg geführt. Mit Threads habe ich nie gearbeitet, und muß es erst einmal irgendwie probieren.
Alle meine Bilder werden aber mit Deinem Code richtig erkannt und mit dem Programm richtig umbenannt. Mache noch ein paar Änderungen was den Namen angeht, aber das sind kosmetische Eingriffe.
Ich versuche gerade das gleiche mit MP4-Video-Dateien. Auch in diesen ist ja ein Datum Medium erstellt !
Das würde ich gerne auslesen, habe aber noch nicht gefunden wie.
Alle drei Methoden der PureBasic-Funktion Ergebnis = GetFileDate(Dateiname$, DatumsTyp) egal mit welchem Parameter:
1. #PB_Date_Created: gibt das Erstellungsdatum der Datei zurück
2. #PB_Date_Accessed: gibt das Datum des letzten Zugriffs auf die Datei zurück
3. #PB_Date_Modified: gibt das Datum der letzten Veränderung an der Datei zurück
Bei 2 und 3 kommt das entsprechend richtige Datum zurück.
Bei 1 kommt ein Datum, welches ich selber im File nicht finden kann. Das wäre aber genau das welches ich bräuchte.
Gruß
Rainer
Re: Procedure wird nicht abgearbeitet
Okay, es freut mich wenn es funktioniert.
Statt Threads kann man auch so etwas machen (stichwort: Statemachine)
Ich habe das mal eben aus zwei Hilfe-Beispielen zusammengeklöppelt......
Diese drei Datumsangaben sind aber Windows-System-Werte. Die findest du nicht in der Datei.
Diese Werte lassen sich im Explorer auch über Eigenschaften oder über die erweiterung der Tabellenanzeige anzeigen .
Das Problem mit diesen Werten ist, dass diese Werte sich durch Programme verändern können, z.B. beim Verschieben, Kopieren, usw.
Fragen? Fragen!
Statt Threads kann man auch so etwas machen (stichwort: Statemachine)
Ich habe das mal eben aus zwei Hilfe-Beispielen zusammengeklöppelt......
Code: Alles auswählen
EnableExplicit
; this is better with enumeration in real apps
#WINDOW_Main = 1
#GADGET_Dir = 1
#GADGET_Start = 2
#TIMER_Scan = 1
#MAX_LOOPS = 10
Procedure ScanDirectory() ; no pParam because of bindevent()
Static s_State = 0
Protected xNextEntry, counter, Directory.s
Debug "#STATE == " + s_State
Select s_State
Case 0 ; --- start
Directory = GetGadgetText(#GADGET_Dir)
If ExamineDirectory(0, Directory, "*.*") ; easy file mask
AddWindowTimer(#WINDOW_Main, #TIMER_Scan, 10) ; Timeout = 10 ms
BindEvent(#PB_Event_Timer, @ScanDirectory(), #WINDOW_Main)
s_State + 1 ; next State
EndIf
Case 1 ; --- walk through the directories
; While NextDirectoryEntry(0)
Repeat
xNextEntry = NextDirectoryEntry(0)
If xNextEntry
If DirectoryEntryType(0) = #PB_DirectoryEntry_File
Debug "[File] " + DirectoryEntryName(0) + " (Size: " + DirectoryEntrySize(0) + ")"
Else
Debug "[Directory] " + DirectoryEntryName(0) ; A directory doesn't have a size
EndIf
EndIf
counter + 1
; Wend
Until xNextEntry = 0 Or counter > #MAX_LOOPS ; only a few loops
If xNextEntry = 0 ; we are done
FinishDirectory(0)
RemoveWindowTimer(#WINDOW_Main, #TIMER_Scan)
s_State = 0 ; next State is initial state
EndIf
Default ; --- finish the scan
s_State = 0 ; ready for next call
EndSelect
EndProcedure
Procedure main()
Protected a
If OpenWindow(#WINDOW_Main, 0, 0, 330, 120, "Scan Directory", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
StringGadget(#GADGET_Dir, 10, 6, 200, 20, "C:\temp\")
ButtonGadget(#GADGET_Start, 10, 32, 80, 24, "Start")
Repeat ; main loop
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
If EventGadget() = #GADGET_Start
ScanDirectory()
EndIf
EndSelect
ForEver ; main loop
EndIf
ProcedureReturn 0
EndProcedure
End main()
Diese Werte lassen sich im Explorer auch über Eigenschaften oder über die erweiterung der Tabellenanzeige anzeigen .
Das Problem mit diesen Werten ist, dass diese Werte sich durch Programme verändern können, z.B. beim Verschieben, Kopieren, usw.
Fragen? Fragen!
Zuletzt geändert von Axolotl am 30.06.2023 11:42, insgesamt 2-mal geändert.
Using PureBasic latest stable version and current alpha/beta (x64) on Windows 11 Home
Re: Procedure wird nicht abgearbeitet
Und dann noch auf die weitere Frage...
Ich habe mal ein Beispiel für das ExifTool by Phil Harvey geschrieben. Siehe hier.
Ich glaube, dass das ExifTool sozusagen der "BestChoice" unter den angebotenen Tools und Libraries ist.
Der Wert, hinter dem du her bist heißt DateCreated (glaube ich). Aber das Internetz ist voll von Beispielaufrufen wie man mit dem Tool Dateien umbenennen kann.
Beisiel: Forum exiftool
Ich habe mal ein Beispiel für das ExifTool by Phil Harvey geschrieben. Siehe hier.
Ich glaube, dass das ExifTool sozusagen der "BestChoice" unter den angebotenen Tools und Libraries ist.
Der Wert, hinter dem du her bist heißt DateCreated (glaube ich). Aber das Internetz ist voll von Beispielaufrufen wie man mit dem Tool Dateien umbenennen kann.
Beisiel: Forum exiftool
Using PureBasic latest stable version and current alpha/beta (x64) on Windows 11 Home
Re: Procedure wird nicht abgearbeitet
Hallo und vielen Dank,Axolotl hat geschrieben: 30.06.2023 11:28 Und dann noch auf die weitere Frage...
Ich habe mal ein Beispiel für das ExifTool by Phil Harvey geschrieben. Siehe hier.
Ich glaube, dass das ExifTool sozusagen der "BestChoice" unter den angebotenen Tools und Libraries ist.
Der Wert, hinter dem du her bist heißt DateCreated (glaube ich). Aber das Internetz ist voll von Beispielaufrufen wie man mit dem Tool Dateien umbenennen kann.
Beisiel: Forum exiftool
habe es mal angesehen, denke da muß ich noch viel lernen bis ich das verstehe was da im Source steht.
Alter Mann>> Autodidakt am Compiler.

Mal sehen was ich mit der Hilfe hinbekomme.
Für Bilder funktioniert es ja nun schon mal recht gut.
Gruß
Rainer
Re: Procedure wird nicht abgearbeitet
Threads sind (immer) ein bischen tricky. Deshalb hatte ich mal ein einfaches Beispiel mit Timer gemacht. (Siehe weiter oben...)PB_Rainer hat geschrieben: 30.06.2023 12:05 habe es mal angesehen, denke da muß ich noch viel lernen bis ich das verstehe was da im Source steht.
Bei Timern gibt es nur das Problem, dass man die Abarbeitung von Timern durch bestimmte Aktionen (z.B. Menu öffnen) anhalten kann, weil dann die sogenannte "Hauptschleife" nicht mehr bearbeitet wird.
Ein Thread läuft immer "nebenläufig", also einfach so vor sich hin. D.h. hier ist der Nachteil, dass bei der Synchronisierung (Zugriff auf gemeinsame Ressourcen) aufgepasst werden muss. Unter Windows ist das nicht ganz so kritisch wie unter den anderen OSes. Deshalb habe ich in meinem Beispiel auf die Verwendung von Mutex, Sempaphore, etc. verzichtet. Wenn du also nicht unter Windows arbeitest, dann empfehle ich dir bspw. die "MiniThreadControl" von mk-soft anzuschauen...
Using PureBasic latest stable version and current alpha/beta (x64) on Windows 11 Home
Re: Procedure wird nicht abgearbeitet
Hallo,
hier nochmals mein Source zu dem Programm.
Bis jetzt funktioniert es ordentlich.
Alle Bilddateien im Ordner, in denen das Exif-Aufnahmedatum steht, werden in einen neu erstellten Unterordner kopiert, mit dem Aufnahmedatum als Pefix. Weiterhin können die Bilder einen eigenen Dateinamen (z.B. Urlaub in München) mit Bildnummer (_0013) erhalten.
Leider habe ich noch keine Möglichkeit gefunden das Aufnahmedatum aus einer MP4-Video-Datei zu lesen, damit wäre es dann komplett.
Danke für Eure Hilfen.
Gruß Rainer
hier nochmals mein Source zu dem Programm.
Bis jetzt funktioniert es ordentlich.
Alle Bilddateien im Ordner, in denen das Exif-Aufnahmedatum steht, werden in einen neu erstellten Unterordner kopiert, mit dem Aufnahmedatum als Pefix. Weiterhin können die Bilder einen eigenen Dateinamen (z.B. Urlaub in München) mit Bildnummer (_0013) erhalten.
Leider habe ich noch keine Möglichkeit gefunden das Aufnahmedatum aus einer MP4-Video-Datei zu lesen, damit wäre es dann komplett.
Danke für Eure Hilfen.
Gruß Rainer
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, Abort_event.i, Exif_Date.s
Global File_Loop.i, PicNum.i, Items_in_Folder.i, List_File.s, File_Extension.s, Rename_FileName.s
Global fItem.LV_FINDINFO, pItem.POINT, sItem.LV_ITEM
; ---== 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
#Statusleiste
#GADGET_CheckBox_CustomName
#GADGET_Edit_CustomName
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, 780, "Photos mit Exif-Date-Time als Preset versehen", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;StickyWindow(#WINDOW_Main, 1) ; always on top, my sreen is a mess :)
CreateStatusBar(#Statusleiste, WindowID(#WINDOW_Main))
AddStatusBarField(110)
StatusBarText(#Statusleiste, 0, "Bilder zu kopieren: ", #PB_StatusBar_Center | #PB_StatusBar_Right | #PB_StatusBar_Raised)
AddStatusBarField(100)
StatusBarText(#Statusleiste, 1, "", #PB_StatusBar_Center)
AddStatusBarField(110)
StatusBarText(#Statusleiste, 2, "EXIF-Information: ", #PB_StatusBar_Right | #PB_StatusBar_Raised)
AddStatusBarField(500)
StatusBarText(#Statusleiste, 3, "")
AddStatusBarField(#PB_Ignore)
StatusBarProgress(#Statusleiste, 4, 0, #PB_StatusBar_BorderLess, 0, 100)
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, GetHomeDirectory() + "\Pictures\*.*", #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, 170, 25, "Programm beenden")
ButtonGadget(#GADGET_Button_rename, 930, 700, 170, 25, "Bilder umbennen starten")
ButtonGadget(#GADGET_Button_rename_abort, 200, 700, 170, 25, "Bilder umbennen abbrechen")
DisableGadget(#GADGET_Button_rename_abort, #True)
CheckBoxGadget(#GADGET_CheckBox_CustomName, 380, 700, 260, 25, "Mit eigenem Namen/Nummer umbenennen?")
GadgetToolTip(#GADGET_CheckBox_CustomName, "Die Bilder bekommen den Namen wie rechts eigegeben und eine fortlaufende, 4-stellige Nummer 0001 - 9999")
EditorGadget(#GADGET_Edit_CustomName, 650, 700, 270, 25)
DisableGadget(#GADGET_Edit_CustomName, #True)
ProcedureReturn 1 ; success
EndIf
ProcedureReturn 0 ; failure
EndProcedure
; ---------------------------------------------------------------------------
Procedure FindStringLIG(searchString.s, SearchInGadget.i)
SendMessage_(GadgetID(SearchInGadget), #LVM_FIRST + $54, $8, 1)
Protected itemNumber.i, I.i
StatusBarText(#Statusleiste, 3, "")
Exif_Date = ""
fItem\flags = #LVFI_STRING
fItem\psz = @searchString
itemNumber = SendMessage_(GadgetID(SearchInGadget), #LVM_FINDITEM, -1, fItem) ; find Item
If itemNumber > -1
Goto SCROLL_AND_SELECT
Else
For I = 0 To CountGadgetItems(SearchInGadget) - 1
If searchString = GetGadgetItemText(SearchInGadget, I, 1)
itemNumber = I
Goto SCROLL_AND_SELECT
EndIf
Next
EndIf
Goto PROC_ERROR
SCROLL_AND_SELECT:
SendMessage_(GadgetID(SearchInGadget), #LVM_GETITEMPOSITION, itemNumber , pItem) ; get item position
SendMessage_(GadgetID(SearchInGadget), #LVM_SCROLL, pItem\x, pItem\y - 150) ; scroll to item position
sItem\mask = #LVIF_STATE
sItem\state = #LVIS_SELECTED
sItem\stateMask = #LVIS_SELECTED
SendMessage_(GadgetID(SearchInGadget), #LVM_SETITEMSTATE, itemNumber , sItem) ; set item state as selected
Exif_Date = GetGadgetItemText(SearchInGadget, itemNumber , 1)
Goto PROC_END
PROC_ERROR:
StatusBarText(#Statusleiste, 3, "Eintrag '" + searchString + "' nicht gefunden :-(")
PROC_END:
EndProcedure
; ---------------------------------------------------------------------------
Procedure Rename_Pictures()
Protected Rename_FileName.s, List_File.s, NumberStr.s
Items_in_Folder = 0
SetActiveGadget(#GADGET_ExpImageFiles)
Rename_Abort = 0
Items_in_Folder = CountGadgetItems(#GADGET_ExpImageFiles)
StatusBarText(#Statusleiste, 1, Str(Items_in_Folder))
ClearGadgetItems(#GADGET_LstImageInfo)
While Items_in_Folder > File_Loop Or Rename_Abort = 1
Repeat
Select WindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case #GADGET_Button_rename_abort
Select EventType()
Case #PB_EventType_LeftClick
ProcedureReturn #False
EndSelect
EndSelect
Case 0
Break
EndSelect
ForEver
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 = "JPEG") Or (File_Extension = "MP4")
If (GetGadgetState(#GADGET_CheckBox_CustomName) = #PB_Checkbox_Checked)
If (GetGadgetText(#GADGET_Edit_CustomName) > "")
Only_filename = GetGadgetText(#GADGET_Edit_CustomName) + "." + File_Extension
EndIf
Else
If Left(UCase(Only_filename), 4) = "IMG_"
Only_filename = Right(Only_filename , Len(Only_filename) - 4)
ElseIf Left(UCase(Only_filename), 4) = "IMG-"
Only_filename = Right(Only_filename , Len(Only_filename) - 4)
ElseIf Left(UCase(Only_filename), 4) = "PXL_"
Only_filename = Right(Only_filename , Len(Only_filename) - 4)
ElseIf Left(UCase(Only_filename), 4) = "CUT_IMG-"
Only_filename = Right(Only_filename , Len(Only_filename) - 8)
EndIf
EndIf
ClearGadgetItems(#GADGET_LstImageInfo)
UpdateImage(List_File)
FindStringLIG("DateTimeDigitized", #GADGET_LstImageInfo)
Exif_Date = ReplaceString(Exif_Date, ":", "" )
Exif_Date = ReplaceString(Exif_Date, " ", "-" )
Exif_Date + "_"
If Exif_Date = "_"
Exif_Date = ""
EndIf
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)
StatusBarText(#Statusleiste, 1, Str(Items_in_Folder - File_Loop) + " von " + Items_in_Folder)
StatusBarProgress(#Statusleiste, 4, File_Loop , #PB_StatusBar_BorderLess , 0, Items_in_Folder)
EndIf
EndIf
File_Loop + 1
Wend
ProcedureReturn #True
EndProcedure
; ---------------------------------------------------------------------------
Procedure SetPictureNumbers()
Protected NumberStr.s, Numbered_FileName.s
Items_in_Folder = 0
If GetGadgetState(#GADGET_CheckBox_CustomName) = #PB_Checkbox_Checked
MessageRequester("Information", "Die Dateien werden mit eigenem Namen umbenannt!", #PB_MessageRequester_Ok | #PB_MessageRequester_Info)
If (GetGadgetText(#GADGET_Edit_CustomName) > "")
File_Loop = 0
SetCurrentDirectory(Rename_Path)
Debug GetCurrentDirectory()
SetGadgetText(#GADGET_ExpImageFiles, GetCurrentDirectory())
SetGadgetItemState(#GADGET_ExpImageFiles, 0, #PB_Explorer_Selected) ;Balken auf ersten Eintrag setzen
PicNum = 1
Items_in_Folder = CountGadgetItems(#GADGET_ExpImageFiles)
While Items_in_Folder > File_Loop
List_File = GetGadgetText(#GADGET_ExpImageFiles) + GetGadgetItemText(#GADGET_ExpImageFiles, File_Loop, 0)
File_Extension = UCase(GetExtensionPart(List_File)) ;Original-Extension speichern
If (File_Extension = "JPG") Or (File_Extension = "JPEG") Or (File_Extension = "MP4")
ShowImagePreview(List_File)
Only_Filename = GetFilePart(List_File, #PB_FileSystem_NoExtension) ;Jede Datei ohne Extension in String einlesen
NumberStr = Right("0000" + Str(PicNum), 4) ;Laufende Nummer auf 4 Stellen setzen
Numbered_FileName = Only_filename + "_" + NumberStr + "." + File_Extension ;Laufende Nummer und Original Extension an Filename ohne Extension anhängen
RenameFile(List_File, Numbered_FileName)
PicNum + 1
EndIf
File_Loop + 1
Wend
Else
MessageRequester("Information", "Sie wollen die Bilder mit einem eigenen Namen umbenennen," + Chr(13)+Chr(10) + "aber es ist kein Dateiname zum Umbenennen eingegeben!" + Chr(13)+Chr(10) + "Wenn Sie den Haken setzen, müssen Sie einen Bildnamen eingeben!", #PB_MessageRequester_Ok | #PB_MessageRequester_Info)
SetGadgetState(#GADGET_CheckBox_CustomName, #PB_Checkbox_Unchecked)
EndIf
EndIf
EndProcedure
; ---== main program ==------------------------------------------------------------------------------------------------
Procedure main()
Protected WndW = 1120, WndH = 780
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()
SetPictureNumbers()
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()
SetPictureNumbers()
EndIf
StatusBarText(#Statusleiste, 1, "")
StatusBarText(#Statusleiste, 3, "")
StatusBarProgress(#Statusleiste, 4, 0 , #PB_StatusBar_BorderLess , 0, 100)
DisableGadget(#GADGET_Button_rename_abort, #True)
DisableGadget(#GADGET_Button_exit, #False)
DisableGadget(#GADGET_Button_rename, #False)
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
Case #GADGET_CheckBox_CustomName
Select EventType()
Case #PB_EventType_LeftClick
If GetGadgetState(#GADGET_CheckBox_CustomName) = #PB_Checkbox_Checked
DisableGadget(#GADGET_Edit_CustomName, #False)
ElseIf GetGadgetState(#GADGET_CheckBox_CustomName) = #PB_Checkbox_Unchecked
DisableGadget(#GADGET_Edit_CustomName, #True)
ClearGadgetItems(#GADGET_Edit_CustomName)
EndIf
EndSelect
EndSelect ; EventGadget()
EndSelect ; WaitWindowEvent()
ForEver ; <-- main loop end
EndIf ; OpenMainWindow()
ProcedureReturn 0
EndProcedure
; ---------------------------------------------------------------------------
End main()
;----== Bottom of File ==----------------------------------------------------------------------------------------------
Re: Procedure wird nicht abgearbeitet
Ich habe zunehmend mehr HEIC Bilder und versuche da die Exif Infos auszulesen. Falls jemand mithelfen mag: https://www.purebasic.fr/english/viewtopic.php?t=81948
"Papa, ich laufe schneller - dann ist es nicht so weit."