Auflösung (dpi) aus TIFF auslesen
Verfasst: 22.06.2018 09:21
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:
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.
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