На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Чтение картинки из TIFF файла , Описание утилитки, позволяющей разобраться в TIFF - тэгах
    swe
    Сообщ. #1 ,

      Junior
      *
      Профиль · PM
      Рейтинг (т): 3
      Передо мной встала задача - загрузить картинку из 16-битного монохромного TIFF файла.
      Готовых компонент найти не удалось. Полезную информацию я нашел здесь: Описание TIFF формата
      Выяснять детали - где хранятся размеры картинки и начальное смещение пришлось выяснять экспериментально. Для этого и была написана предлагаемая ниже утилита:

      ExpandedWrap disabled
        (*       -- программа работает без формы! --       *)
        (* выбираем из текущей директории все 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 :

      ExpandedWrap disabled
        имя файла                порядок_байт Версия Оффсет_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
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0237 ]   [ 16 queries used ]   [ Generated: 7.10.24, 18:08 GMT ]  
        Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.