Seite 1 von 1

Auflösung (dpi) aus TIFF auslesen

Verfasst: 22.06.2018 09:21
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.