Phototools - Interactive Editing Of JPG-Comments - Old Version

This tool helps me organizing my ever growing collection auf digital photos by supporting me in commenting them.

Though it is totally incomplete yet, it shouldn't destroy your JPGs or even alter them, unless you hit the Save Changes!-button. No guarantees!

  • Save the following code to a .BATchfile via cut+paste.
  • To call this program, type
        batfile <folder-with-jpgs>
  • What you see in the main window is the first image in that folder; at the bottom there are up to six small thumbnails of the next (and previous) pictures in that folders, so you see what series of pictures are in the folder
  • There are Buttons < << >> > to navigate through the images, and an entry field to type the comment for each separate image.
  • At the top there is another entry field to type a comment, which is applied to all images which havent't a comment yet.
  • More infos, screenshots, extensions (and error corrections...) - hopefully - later ;-)
_
https://image.jimcdn.com/app/cms/image/transf/none/path/s1b9371b41c82e69b/image/i4e4adbd87bbaf0d3/version/1490300807/image.jpg
 ::if 0 {
 @start wish %~dp0\%~n0.bat %*
 @goto :EOF
 }

 #
 # jpegcedt3 - Jpeg Comment Edit - 01.08.2007 - Variante mit CANVAS
 # * 09.10.2007 - Button >+, Bugfixe. Jedoch ist die Optik jetzt ziemlich kaputt...
 # Blättern durch ein Bilderverzeichnis; zeige Miniaturansicht + Kommentar zum
 # Editieren (mit jpegccmt vorbesetzt; später hier Feld "Kommentare für alle Bilder")
 # ToDo:
 #  - das GESAMTE Fensterlayout neu gestalten...
 #  - später einen FORCE-Flag zum Überschreiben (und also auch Löschen) auch bestehender Kommentare
 #  - Vergrössern ist hässlich...
 #  - Verbesserte Thumbanzeige, Tree links
 #  - [X] KeepDate
 #  - Buttons colorieren usw. nach bekanntem Muster, focus-Steuerung usw. wie gehabt
 #  - SaveChanges erst dann freigeben, wenn Changes da!
 #  - Reset: Bilderspeicher freigeben, Speicher leerräumen! Z.B. beim Speichern?
 #  - Undo
 #  - ProgressBar bei Load etc.
 #  - Wählbare Skalierung mittels +/-
 #  - OptionenDB statt indiv. Einstellungen
 #  - gButton-Paket nutzen
 #  - gesamte Resizing-Steuerung klappt nicht. Layout überarbeiten!
 # - 13.03.2008: Cursor nach "Übernehmen" ins untere Eingabefeld setzen; Optimierungen;
 #    ChangeFlag sofort setzen, wenn Feldinhalt. Einiziges Feld auch sichern, wenn noch nicht mit < >
 #    gewechselt.
 #

 wm withdraw .
 package require jpeg
 package require img::jpeg

 # Ist sichergestellt, daß 640x480 nicht ÜBERSCHRITTEN wird?
 proc scaleFactor {picFile reqX reqY} {
      foreach {picX picY} [::jpeg::dimensions $picFile] break;
      if {$picX < $picY} {
         # foreach {picX picY} [list $picY $picX] break; # swap - neue Variante
         return [expr {1.0 * $reqY / $picY}]
      }
      return [expr {1.0 * $reqX / $picX}]
 }
 # wiki.tcl.tk/8448 - siehe PHOTOPRINTER; evtl. schon optimierte Version dort oder im Web, oder lib
 # Shrink: siehe auch https://wiki.tcl-lang.org/10504
 #  - Aufgrund von Rundungen sind die Zielgrössen nicht exakt zu erreichen....
 proc scaleImage {im xfactor {yfactor 0}} {
      set mode -subsample
      if {abs($xfactor) < 1} {
         set xfactor [expr round(1./$xfactor)]
      } elseif {$xfactor>=0 && $yfactor>=0} {
         set xfactor [expr {int($xfactor)}]
         set yfactor [expr {int($yfactor)}]
         set mode -zoom
      }
      if {$yfactor == 0} {
         set yfactor $xfactor
      }
      set t [image create photo]
      $t copy $im
      $im blank
      $im copy $t -shrink $mode $xfactor $yfactor
      image delete $t
 }
 proc savePicInfo {} {
      global pBuf
      # sichert ggF. geändertes Eingabefeld, bevor weitergewandert wird
      set temp [.c1 get]
      # tk_messageBox -title Debug1 -message "!!!$temp!!!\n!!!$pBuf($pBuf(0,currPic),Comment)!!!"
      if {$temp != $pBuf($pBuf(0,currPic),Comment)} {
         set pBuf($pBuf(0,currPic),Comment) $temp
         set pBuf($pBuf(0,currPic),state)   *
      }
 }
 proc showPic {} {
      global pBuf
      set nr $pBuf(0,currPic)
      if {$pBuf($nr,imgHdl) == ""} {
         set pBuf($nr,imgHdl)  [image create photo -file $pBuf($nr,file) -format [list jpeg -fast]];# -height 640 -width 640 geht nicht
         scaleImage $pBuf($nr,imgHdl) [scaleFactor $pBuf($nr,file) 640 480]; # schlecht: Operation wird JEDESMAL durchgeführt.......
      }
      # .l1 configure -image $pBuf($nr,imgHdl)
      catch {.zz delete all}
      .zz create image 0 0 -image $pBuf($nr,imgHdl) -anchor nw
      .l2 configure -text $pBuf($nr,state)
      .c1 delete 0 end
      # wenn kein Kommentar da, VORGABE übernehmen!
      if {$pBuf($nr,Comment) == ""} {
         set pBuf($nr,Comment) [.c0 get]
         set pBuf($nr,state) *
      }
      .c1 insert 0 $pBuf($nr,Comment)
      wm title . "jpegcedt3 Bild $nr von $pBuf(0,numPics) '[file tail $pBuf($nr,file)]'"
      showThumbs
      update
 }
 proc firstPic {} {
      global pBuf
      savePicInfo
      set pBuf(0,currPic) 1
      showPic

 }
 proc prevPic {} {
      global pBuf
      savePicInfo
      if {$pBuf(0,currPic) > 1} {
         incr pBuf(0,currPic) -1
      } else {
         set pBuf(0,currPic) $pBuf(0,numPics)
      }
      showPic

 }
 proc nextPic {{cloneComment 0}} {
      global pBuf
      savePicInfo
      if {$pBuf(0,currPic) < $pBuf(0,numPics)} {
         set oldPic $pBuf(0,currPic)
         incr pBuf(0,currPic)
         set currPic $pBuf(0,currPic); # shortCut
         if {$cloneComment > 0 && $pBuf($currPic,Comment) == ""} {
            # Button >+ übernimmt Kommentar vom vorherigen Bild (nur zum nächsten hin)
            set pBuf($currPic,state) *
            set pBuf($currPic,Comment) $pBuf($oldPic,Comment)
         }
      } else {
         set pBuf(0,currPic) 1
      }
      showPic
 }
 proc lastPic {} {
      global pBuf
      savePicInfo
      set pBuf(0,currPic) $pBuf(0,numPics)
      showPic
 }
 proc saveComments {} {
      global pBuf
      savePicInfo
      for {set i 1} {$i <= $pBuf(0,numPics)} {incr i} {
         if {$pBuf($i,state) == "*"} {
            # tk_messageBox -title Debug -message "$pBuf($i,file) $pBuf($i,Comment)"
            ::jpeg::replaceComment $pBuf($i,file) $pBuf($i,Comment)
            # bestehende Änderungszeit restaurieren (evtl. optional)!
            file mtime $pBuf($i,file) $pBuf($i,time)
            # Nun die CHANGEFLAGS (state) ZURÜCKSETZEN, da gesichert!
            set pBuf($i,state) ""
         }
      }
      .l2 configure -text ""
 }
 proc showThumbs {} {
      global pBuf
      # z.Zt. maximal 6 Thumbs, beginnend mit dem aktuell gross gezeigten Bild,
      # anzeigen. Später hierüber eine Auswahl ermöglichen etc.
      set i 0
      foreach offs {0 1 2 3 4 5} {
         incr i
         if {$i > $pBuf(0,numPics)} {
            # nicht mehr Thumbs zeigen, als überhaupt Bilder da sind...
            return
         }
         set thumbNr [expr {$pBuf(0,currPic) + $offs}]
         if {$thumbNr > $pBuf(0,numPics)} {
            incr thumbNr -$pBuf(0,numPics)
         }
         if {$pBuf($thumbNr,thumbImgHdl) == ""} {
            set pBuf($thumbNr,thumbImgHdl) [image create photo -data $pBuf($thumbNr,thumb) -format [list jpeg -fast]]
            # für's erste; schlecht: geschieht immer wieder!
            scaleImage $pBuf($thumbNr,thumbImgHdl) 0.5
         }
         catch {
            pack forget .f1.$offs
            destroy .f1.$offs
         }
         label .f1.$offs -image $pBuf($thumbNr,thumbImgHdl)
         pack  .f1.$offs -side left -padx 1
      }
 }
 proc putDefCmt {} {
      global pBuf
      set tpl [.c0 get]
      if {[string length $tpl]} {
         for {set i 1} {$i <= $pBuf(0,numPics)} {incr i} {
            if {$pBuf($i,Comment) == ""} {
               set pBuf($i,Comment) $tpl
               set pBuf($i,state) *
            }
         }
         showPic
         focus .c1
      }
 }
 # Änderungskennzeichen setzen, sobald ein Inhalt im Feld vorhanden ist
 proc setState {newVal} {
      global pBuf
      set currPic $pBuf(0,currPic); # shortCut
      if {[string length "$newVal"]} {
         # kann ruhig jedesmal durchgeführt werden...
         set pBuf($currPic,state) "*"
         .l2 configure -text "*"
      } else {
         set pBuf($currPic,state) ""
         .l2 configure -text ""
      }
      update
      return 1
 }
 # Argumente
 set picFolder [lindex $argv 0]; # NICHT-REKURSIV; nur hier suchen!
 set fileMask  [lindex $argv 1]
 if {[string length $fileMask] == 0} {
    set fileMask [list *.{jpg,jpeg}]
 }
 # Erst nur Namen einlesen. Navigate_to_Next/Prev/First/Last über Buttons.
 set pics [glob -type f -nocomplain -dir $picFolder $fileMask]
 if {[llength $pics] == 0} {
    tk_messageBox -icon warning -message "Keine JPG's im Ordner '$picFolder' gefunden!" -title ACHTUNG!
    exit 1
 }
 # es fehlt ProgressBar
 set pBuf(0,numPics) [llength $pics]
 set pBuf(0,currPic) 1
 set picNr 0
 foreach pic $pics {
    incr picNr
    set pBuf($picNr,file) $pic
    set pBuf($picNr,state) ""
    set pBuf($picNr,time) [file mtime $pic]
    set pBuf($picNr,Comment) [string trim [join [::jpeg::getComments $pic]]]; # vorhandene Kommentare einlesen
    set pBuf($picNr,imgHdl) ""
    # Das folgende sollte nur für die ersten n Bilder geschehen, danach erst bei Bedarf nachlesen!
    # oder gleich image create photo hier? Es fehlt: wenn kein Thumb da, ein solches ERZEUGEN!
    set pBuf($picNr,thumb) [::jpeg::getThumbnail $pic]; # ACHTUNG: langsam!? Was passiert bei Fehlern?? Wenn kein Thumb existiert, erzeugen!
    set pBuf($picNr,thumbImgHdl) ""
 }
 frame .f1
 canvas .zz -width 640 -height 480
 # label .l1
 button .b1  -text " << " -command [list firstPic]  -width 4
 button .b2  -text " <  " -command [list prevPic]   -width 4
 button .b3  -text " >  " -command [list nextPic]   -width 4
 button .b3a -text " >+ " -command [list nextPic 1] -width 4
 button .b4  -text " >> " -command [list lastPic]   -width 4
 button .b5  -text " Save Changes! " -command [list saveComments]; # erst aktivieren, WENN Änderungen aktiv!
 button .b6  -text " -> Übernehmen " -command [list putDefCmt]   ; # erst aktivieren, wenn Kommentartemplate ungleich ""
 entry .c1 -text "" -width 60 -font {-family tahoma -size 8} -validate key -vcmd [list setState %P]
 entry .c0 -text "" -width 60 -font {-family tahoma -size 8}
 label .l2 -text ""
 grid .c0  -row 0 -column 0 -sticky nsew
 grid .b6  -row 0 -column 1 -sticky nsew
 grid .b5  -row 0 -column 6 -sticky nsew
 grid .zz  -row 1 -column 0 -sticky nsew -columnspan 7
 grid .c1  -row 2 -column 0 -sticky nsew
 grid .l2  -row 2 -column 1 -sticky nsew
 grid .b1  -row 2 -column 2 -sticky nsew
 grid .b2  -row 2 -column 3 -sticky nsew
 grid .b3  -row 2 -column 4 -sticky nsew
 grid .b3a -row 2 -column 5 -sticky nsew
 grid .b4  -row 2 -column 6 -sticky nsew
 # Zusätzlich für Thumbanzeige (rudimentär)
 grid .f1  -row 3 -column 0 -sticky nsew -columnspan 7
 showPic
 wm deiconify .
 focus -force .c1

AF provides a hint: instead of using scaleImage to create a thumbnail you could use the functions in the jpeg package to check for an exif or jfxx thumbnail embedded in the image. MHo: Yes, that's one thing I have on my list: a routine to abstract the thumb display as to check first, if the jpeg already contains a thumb. But first of all I must work out some other mysterious things. As always: nearly no time to code all ideas...

Category FileCategory GraphicsCategory Image Processing
Updated 2020-03-04 21:57:03