Auflösung (dpi) aus TIFF auslesen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
fabulouspaul
Beiträge: 120
Registriert: 01.04.2011 21:59

Auflösung (dpi) aus TIFF auslesen

Beitrag von fabulouspaul »

Hallo zusammen,

für ein kleines Projekt musste ich die Auflösung in dpi eines TIFF-Images direkt aus der Datei auslesen.
Die Rückgabe der 2 Parameter (X- und Y-Auflösung) aus der Prozedur ist nicht so ideal gelöst, aber ich wollte kein Array oder eine Liste verwenden.

Vielleicht kann es jemand gebrauchen:

Code: Alles auswählen

; Auflösung (dpi) aus TIFF-Datei auslesen

EnableExplicit

Define dateiname.s
Define ergebnis.s

Declare.s Read_TIF_DPI(datei.s)

dateiname = OpenFileRequester("TIF-Datei wählen", "", "*.TIF (TIFF-Files)|*.TIF|alle Dateien|*.*", 0)

If dateiname <> ""  
  ergebnis = Read_TIF_DPI(dateiname)
  
  If ergebnis <> ""
    MessageRequester("Ergebnis", "Auflösung der TIFF-Datei " + GetFilePart(dateiname) + #LF$ +
                    StringField(ergebnis, 1, "|") + " x " + StringField(ergebnis, 2, "|") + " dpi")
  Else
    MessageRequester("Fehler", "Auflösung konnte nicht aus der Datei ausgelesen werden (kein TIFF?).")
  EndIf
EndIf
  
End

Procedure.s Read_TIF_DPI(datei.s)
  
  Structure Entry
    tag.w             ; Funktions-Tag des Eintrags (siehe http://www.fileformat.info/format/tiff/corion.htm)
    type.w            ; Datentyp des Wertes (1=Byte, 2=ASCII-String, 3=Word, 4=Long, 5=Bruch aus 2x Long)
    length.l          ; Anzahl der mit type beschriebenen Werte 
    offset.l          ; Position in der Datei (absolut vom Anfang); offset kann der Wert selber sein, falls die länge <= 4 (abhängig von type) ist
  EndStructure

  Protected file_handle 
  Protected i
  Protected dir_entries.w
  Protected NewList directory.entry()
  Protected x_res.l, y_res.l, res_unit.w
  
  file_handle = ReadFile(#PB_Any, datei) 
  
  If file_handle
    ; TIF-Header?
    If ReadString(file_handle, #PB_Ascii, 4) <> "II*"
      CloseFile(file_handle)
      ProcedureReturn ""
    Else
      ; Zum Start der TIFF-Directorys springen
      FileSeek(file_handle, ReadLong(file_handle))
      
      ; Anzahl der Directory-Einträge
      dir_entries = ReadWord(file_handle)
      
      ; Directory-Einträge einlesen
      For i = 1 To dir_entries
        AddElement(directory())
        directory()\tag    = ReadWord(file_handle)
        directory()\type   = ReadWord(file_handle)
        directory()\length = ReadLong(file_handle)
        directory()\offset = ReadLong(file_handle)      
      Next
      
      ForEach directory()
        Select directory()\tag
          Case $128         ; Resolution Unit (sollte i.d.R. 0002 = Inch sein)
            res_unit = directory()\offset
            If res_unit <> 2
              CloseFile(file_handle)
              ProcedureReturn ""
            EndIf
            
          Case $11A         ; XResolution
            ; zur Stelle mit der X-Auflösung springen
            FileSeek(file_handle, directory()\offset)
            ; Darstellungsform berücksichtigen
            If directory()\type = 5
              ; Wert als Bruch von 2 Longs abgelegt (Zähler & Nenner)
              x_res = ReadLong(file_handle)
              x_res = x_res / ReadLong(file_handle)
            ElseIf directory()\type = 4
              ; Wert als Long abgelegt
              x_res = ReadLong(file_handle)
            ElseIf directory()\type =3
              ; Wert als Word abgelegt
              x_res = ReadWord(file_handle)
            EndIf
            
          Case $11B         ; YResolution
            ; zur Stelle mit der Y-Auflösung springen
            FileSeek(file_handle, directory()\offset)
            ; Darstellungsform berücksichtigen
            If directory()\type = 5
              ; Wert als Bruch von 2 Longs abgelegt (Zähler & Nenner)
              y_res = ReadLong(file_handle)
              y_res = y_res / ReadLong(file_handle)
            ElseIf directory()\type = 4
              ; Wert als Long abgelegt
              y_res = ReadLong(file_handle)
            ElseIf directory()\type =3
              ; Wert als Word abgelegt
              y_res = ReadWord(file_handle)
            EndIf
            
        EndSelect
      Next    
    EndIf
    
    CloseFile(file_handle)
    
    ; die 2 Auflösungen in einem String, getrennt mit "|" zurückgeben
    ProcedureReturn Str(x_res) + "|" + Str(y_res)
  Else
    ProcedureReturn ""
  EndIf
  
EndProcedure
Auf http://www.fileformat.info/format/tiff/corion.htm findet man auch weitere Funktions-Tags, falls man andere Informationen aus der TIFF-Datei auslesen will.