Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[98.80.143.34] |
|
Сообщ.
#1
,
|
|
|
Передо мной встала задача - загрузить картинку из 16-битного монохромного TIFF файла.
Готовых компонент найти не удалось. Полезную информацию я нашел здесь: Описание TIFF формата Выяснять детали - где хранятся размеры картинки и начальное смещение пришлось выяснять экспериментально. Для этого и была написана предлагаемая ниже утилита: (* -- программа работает без формы! -- *) (* выбираем из текущей директории все TIFF файлы *) (* для каждого TIFF файла читаем теги *) (* и выводим их в текстовый файл TIFF.TXT *) program TIFFTags; uses Windows, Classes, SysUtils; type TDirRec = class (TObject) Attr: word; Time: Longint; Size: Longint; Name: string[255]; end; TDirList = class(TList) procedure Done; (* освободить память *) procedure CollectExt(aPath:string;sExt:string); (* собрать по Ext *) procedure CollectTpl(PathTpl:string); (* добавить файлы соотв-щие шаблону *) end; (* TDirList *) (*============================================================================*) (* служебные функции *) procedure WarnAbs(S:string); (* неподавляемый WARN *) begin MessageBox(GetActiveWindow,PChar(S), PChar('ПРЕДУПРЕЖДЕНИЕ ИЛИ НАПОМИНАНИЕ'),MB_OK); end; function AddBackSlashForce(Path:string):string; (* проверяет, что Path - именно каталог, а не файл, добавляет '\' в конец *) begin if length(Path) = 0 then begin result := Path; Exit; end; (* Current Path *) if Path[Length(Path)] <> '\' then if Not SysUtils.FileExists(Path) then Path := Path + '\'; Result := Path; end; (*============================================================================*) (* перебор файлов в текущей поддиректории *) procedure TDirList.Done; var D : TDirRec; I : integer; begin for I := Self.Count-1 downto 0 do begin D := TDirRec(Items[I]); D.Name := ''; (* освобождаем память, занятую строкой *) D.Free; Self.Delete(I); end; end; procedure TDirList.CollectTpl(PathTpl:string); var F : TSearchRec; D : TDirRec; DosError : integer; begin DosError := FindFirst(PathTpl, faReadOnly + faHidden + faDirectory + faArchive, F); while (DosError = 0) do begin D := TDirRec.Create; D.Attr := F.Attr; D.Time := F.Time; D.Size := F.Size; D.Name := F.Name; Add(D); DosError := FindNext(F); end; FindClose(F); end; procedure TDirList.CollectExt(aPath:string;sExt:string); var PathTpl : string; begin if Not DirectoryExists(aPath) then begin WARNAbs('DirList.CollectExt: Path <'+aPath+'> Not found!'); Exit; end; if Count <> 0 then Done; (* "забыть" предыдущую коллекцию файлов *) aPath := AddBackSlashForce(aPath); PathTpl := aPath +'*.' + sExt; (* шаблон для FindFirst/FindNext *) CollectTpl(PathTpl); end; (*============================================================================*) (* строковые функции *) const hexChars: array [0..$F] of char = '0123456789ABCDEF'; function HexB(B:byte):string; begin HexB:=hexChars[B shr 4]+hexChars[B and $F] end; function HexW(W:word):string; begin HexW:=HexB(Hi(W))+HexB(Lo(W)) end; function ISt(I:Int64):string; begin result := IntToStr(I) end; function NSt(I:longint;D:integer):string;(*ЦЕЛОЕ В СТРОКУ С ВЕДУЩИМИ пробелами*) var S : string; begin Str(I,S); if length(S) > D then S := copy(S,length(S)-D+1,D); (* правая часть *) while length(S) < D do S := ' '+S; NSt := S; end; function SSt(S:string;N:integer):string; var L : integer; begin L := length(S); if L < N then begin SetLength(S,N); FillChar(S[L+1],N-L,' '); end; result := S; end; (*============================================================================*) (* главная процедура *) procedure ExploreTiff; var fo : System.Text; (* выходной файл *) fi : file of word; (* для входных TIFF - файлов *) fno : string; (* имя выходного файла *) fni : string; (* имя исследуемого файла *) aDir : TDirList;(* для сбора списка TIFF - файлов *) aFil : TDirRec; (* данные текущего файла *) sDir : string; (* имя текущего каталога *) S,S1,S2,S3 : string; ITiff : integer; ITag : integer; NTag : integer; W : word; WA : packed array[1..2] of word; N2 : DWORD absolute WA; WId : word; WTy : word; LNa : integer; (* макс.длина имени файла *) L2,L3 : integer; begin fno := 'TIFF.txt'; aDir := TDirList.Create; sDir := SysUtils.GetCurrentDir; aDir.CollectExt(sDir,'tif'); Assign(fo,fno); rewrite(fo); LNa := 0; for ITiff := 0 to aDir.Count-1 do begin aFil := aDir.Get(ITiff); fni := aFil.Name; if LNa < length(fni) then LNa := length(fni); end; S1 := 'имя файла '; S2 := 'порядок_байт '; S3 := 'Версия '; if LNa < length(S1) then LNa := length(S1); LNa := LNa + 1; L2 := length(S2); L3 := length(S3); S := SSt(S1,LNa)+S2+S3+'Оффсет_IDF Тэгов'; writeln(fo,S); S := SSt('умолчания:',LNa)+SSt('$4949',L2)+SSt('$002A',L3)+'$00000008 19'; writeln(fo,S); for ITiff := 0 to aDir.Count-1 do begin aFil := aDir.Get(ITiff); fni := aFil.Name; S := SSt(fni,LNa); Assign(fi,fni); Reset(fi); read(fi,W); S := S + SSt('$'+HexW(W),L2); (* порядок байт *) read(fi,W); S := S + SSt('$'+HexW(W),L3); (* версия TIFF *) read(fi,WA[1]); (* offset IDF *) read(fi,WA[2]); (* offset IDF *) S := S + '$'+HexW(WA[2])+HexW(WA[1])+' '; read(fi,W); S := S + ISt(W); (* число тегов *) writeln(fo,S); System.Close(fi); end; for ITiff := 0 to aDir.Count-1 do begin aFil := aDir.Get(ITiff); fni := aFil.Name; (* далее открываем двоичный файл, чтобы прочитать теги *) Assign(fi,fni); Reset(fi); read(fi,W); read(fi,W); read(fi,WA[1]); read(fi,WA[2]); read(fi,W); NTag := W; writeln(fo); writeln(fo,SSt(fni,LNa)+'ТЭГИ ---------------------'); // $1234 $1234 2000000000 $12341234 S := ' № Id_тега DataType NValue Offset/Value'; writeln(fo,S); for ITag := 1 to NTag do begin read(fi,WId); read(fi,WTy); read(fi,WA[1]); read(fi,WA[2]); S := NSt(ITag,3)+' $'+HexW(WId)+' $'+HexW(WTy)+' '+ NSt(N2,10); read(fi,WA[1]); read(fi,WA[2]); S := S+' $'+HexW(WA[2])+HexW(WA[1])+' '+NSt(N2,10); writeln(fo,S); end; System.Close(fi); end; System.Close(fo); end; (* ExploreTiff *) Begin ExploreTiff; End. Полученную в результате компиляции программу нужно запускать в том каталоге, в котором размещены TIFF файлы. В результате получается текстовое описание содержащихся в них тегов. Пример результата работы программы tifftags.exe : имя файла порядок_байт Версия Оффсет_IDF Тэгов умолчания: $4949 $002A $00000008 19 12x16_2byte.tif $4949 $002A $00000008 19 12x16_2byteRGB.tif $4949 $002A $00000008 20 8x8_1byte.tif $4949 $002A $00000008 19 8x8_2byte.tif $4949 $002A $00000008 19 12x16_2byte.tif ТЭГИ --------------------- № Id_тега DataType NValue Offset/Value 1 $00FE $0004 1 $00000000 0 2 $0100 $0003 1 $0000000C 12 3 $0101 $0003 1 $00000010 16 4 $0102 $0003 1 $00000010 16 5 $0103 $0003 1 $00000001 1 6 $0106 $0003 1 $00000001 1 7 $0111 $0004 1 $000046BC 18108 8 $0112 $0003 1 $00000001 1 9 $0115 $0003 1 $00000001 1 10 $0116 $0003 1 $00000010 16 11 $0117 $0004 1 $00000180 384 12 $011A $0005 1 $000000F2 242 13 $011B $0005 1 $000000FA 250 14 $0128 $0003 1 $00000002 2 15 $0131 $0002 28 $00000102 258 16 $0132 $0002 20 $0000011E 286 17 $02BC $0001 15398 $00000132 306 18 $8649 $0001 2404 $00003D58 15704 19 $8769 $0004 1 $0000483C 18492 ... Отсюда легко вычислить, что: ширина картинки лежит в тэге $0100, высота - в тэге $101, число бит на пиксель в тэге $0102, начальное смещение картинки в тэге $0111 и число байт картинки в тэге $0117 |