VPF::Разрешение изображения - Форум программистов

Pavelbej

Дата 25.7.2006, 23:01 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

В листбокс-е находятся изображения (путь и имя файла). Этот код (создание Bitmap-a) делается только для того чтобы узнать разрешение изображения (GetBitmapDimensionsString(MyBitmap)) но что-то мне подсказывает что нужно что-то другое. Помогите, если можете, файлов много и тормозит жутко. Заранее всем благодарен в решении этой проблемы.

Код


procedure TForm1.ListBox1Click(Sender: TObject);
var  MyPicture : TPicture;
begin
      Image1.Picture.LoadFromFile(ListBox1.Items[ListBox1.itemindex]);
      try
        if assigned (MyBitmap) then MyBitmap.Free;
        MyBitmap := TBitmap.Create;
        MyPicture := TPicture.Create;
        try
              MyPicture.LoadFromFile (ListBox1.Items[ListBox1.itemindex]);
              try
                 MyBitmap.Assign (MyPicture.Graphic);
              except
              end;
        finally
           MyPicture.Free;
        end;
     finally
     end;

     Label5.Caption := 'Name: '+ExtractFileName (ListBox1.Items[ListBox1.itemindex]);
//==================================================================
     Label3.Caption := 'Resolution: '+GetBitmapDimensionsString(MyBitmap);
//==================================================================
     Label1.Caption:= format( 'Size: %0.1f КB', [ GetFileSizeByName(ListBox1.Items[ListBox1.itemindex]) / 1024 ] );
end;

Romikgy

Дата 26.7.2006, 08:48 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: нет
Всего: 146

А нельзя ли просто
Image1.Picture.LoadFromFile(ListBox1.Items[ListBox1.itemindex]);
GetBitmapDimensionsString(Image1.Picture.Bitmap);

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Alexeis

Дата 26.7.2006, 10:01 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Вот самый быстрый способ

Код


procedure TForm1.btn1Click(Sender: TObject);
var
  f : TFileStream;
  w, h : LongInt;
begin
  if dlgOpen1.Execute
  then
    Begin
      f := TFileStream.Create(dlgOpen1.FileName,
                             fmOpenRead or fmShareDenyWrite);
      f.Seek(18, soFromBeginning); //Cдвиг на данные о разрешении
      f.ReadBuffer(w, SizeOf(w));
      f.ReadBuffer(h, SizeOf(h));
      f.Free;
      ShowMessage('Width='+IntToStr(W)+ ' ' +
                'Height='+ IntToStr(H));
    end;
end;

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Pavelbej

Дата 26.7.2006, 13:21 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

alexeis1, большое спасибо, вот только резолюцию этот код показывает не как например "1024 х 768", а какието цифры при том что файлы имеют одинаковую резолюцию. Вот примерно что у меня "-318832640 х 1967395072", "-168427523 х 1380137728" и оба файла тот же размер имеют по горизонтали и вертикали, оба файла - .jpg, первый весит 47 Кб - второй 88 Кб (на всякий случай).

В чем причина может быть?

Alexeis

Дата 26.7.2006, 13:25 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Pavelbej, Этот код работает только для BMP. Для JPG надо устанавливать другое смещение

--------------------

Pavelbej

Дата 26.7.2006, 14:26 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

Покажи пример пожалуйста. И прокоментируй код если тебе не трудно а то для меня это вче ново.

Romikgy

Дата 26.7.2006, 14:58 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: нет
Всего: 146

TJPEGImage не?
в нем есть и высота и ширина smile

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

dumb

Дата 26.7.2006, 15:05 (ссылка)

(нет голосов)

Загрузка ...

sceloglauxalbifacies

Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: нет
Всего: 158

sorry, no comments... smile

Код


function JPEGDimensions(Filename : string; var X, Y : Word) : boolean;
var
  SegmentPos : Integer;
  SOIcount : Integer;
  b : byte;
begin
  Result := False;
  with TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone) do begin
    try
      Position := 0;
      Read(X, 2);
      if (X <> $D8FF) then exit;
      SOIcount := 0;
      Position := 0;
      while (Position + 7 < Size) do begin
        Read(b, 1);
        if (b = $FF) then begin
          Read(b, 1); 
          if (b = $D8) then
            inc(SOIcount);
          if (b = $DA) then
            break;
        end; {if}
      end; {while}
      if (b <> $DA) then exit;
      SegmentPos := -1;
      Position := 0;
      while (Position + 7 < Size) do begin
        Read(b, 1);
        if (b = $FF) then begin
          Read(b, 1);
          if (b in [$C0, $C1, $C2]) then begin
            SegmentPos := Position;
            dec(SOIcount);
            if (SOIcount = 0) then break;
          end; {if}
        end; {if}
      end; {while}
      if (SegmentPos = -1) then exit;
      if (Position + 7 > Size) then exit;
      Position := SegmentPos + 3;
      Read(Y, 2);
      Read(X, 2);
      X := Swap(X);
      Y := Swap(Y);
      Result := true;
    finally 
      Free; 
    end; {try}
  end; {with} 
end; {JPEGDimensions}

Alexeis

Дата 26.7.2006, 16:15 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(Pavelbej @ 26.7.2006, 14:26

)

И прокоментируй код если тебе не трудно а то для меня это вче ново.

Ничего сложного если знать формат файла, то для получения разрешения не нужно загружать изображение полностью, достаточно знать где в этом файле хранится значение высоты и ширины. В BMP, эти положения фиксированы. После заголовка FileHeader идет InnfoHeader, второе и третие поля которого высота и ширина, вот я и пропустил все ненужные данные и перескочил прямо к ним.

--------------------

Pavelbej

Дата 26.7.2006, 16:37 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

dumb, я попробовал, вроде все нормально но у некоторых файлов разрешение отображается неправильно, почему не знаю.

Вот я что нашел но это для (( Dots Per Inch )) и (( Dots Per Cm)). Посмотрите может измените код чтобы узнать горизонтальный и вертикальный размер изображения в пикселях:

Код


procedure GetResJpg(JPGFile: string); 
const 
  BufferSize = 50; 
var 
  Buffer: string; 
  Index: integer; 
  FileStream: TFileStream; 
  HorzRes, VertRes: Word; 
  DP: Byte; 
  Measure: string; 
begin 
  FileStream := TFileStream.Create(JPGFile, 
    fmOpenReadWrite); 
  try 
    SetLength(Buffer, BufferSize); 
    FileStream.Read(buffer[1], BufferSize); 
    Index := Pos('JFIF' + #$00, buffer); 
    if Index > 0 then 
    begin 
      FileStream.Seek(Index + 6, soFromBeginning); 
      FileStream.Read(DP, 1); 
      case DP of 
        1: Measure := 'DPI'; //Dots Per Inch 
        2: Measure := 'DPC'; //Dots Per Cm. 
      end; 
      FileStream.Read(HorzRes, 2); // x axis 
      HorzRes := Swap(HorzRes); 
      FileStream.Read(VertRes, 2); // y axis 
      VertRes := Swap(VertRes); 
    end 
  finally 
    FileStream.Free; 
  end; 
end;

dumb

Дата 26.7.2006, 16:50 (ссылка)

(нет голосов)

Загрузка ...

sceloglauxalbifacies

Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: нет
Всего: 158

покажи(прикрепи, выложи куда-нибудь) пару файлов, у которых неправильно отображается разрешение.

Pavelbej

Дата 26.7.2006, 17:02 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

Вот эти например не отображались правильно:

image

Alexeis

Дата 26.7.2006, 17:11 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(Pavelbej @ 26.7.2006, 16:37

)

Посмотрите может измените код чтобы узнать горизонтальный и вертикальный размер изображения в пикселях:

В любом случае все перечисленные способы мягко говоря некорректны!

Добавлено @ 17:16
Нельзя запускать простой поиск, поскольку среди значений даннных могут встречатся указанные комбинации.
Вот ссылка на подробное описание формата на русском языке
http://www.matrix-wb.h1.ru/article/formats/jpeg-rus.html
Смотрите вконце описание "SOF0: Начало Кадра 0:"
Разбор надо вести сегменрами а не байтами, тогда точно попадете на нужные места и не будет случайных совпадений вызывающих ложную остановку поиска!

Это сообщение отредактировал(а) alexeis1 - 26.7.2006, 17:26

--------------------

dumb

Дата 26.7.2006, 17:48 (ссылка)

(нет голосов)

Загрузка ...

sceloglauxalbifacies

Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: нет
Всего: 158

Цитата(alexeis1 @ 26.7.2006, 17:11

)

Разбор надо вести сегменрами а не байтами, тогда точно попадете на нужные места и не будет случайных совпадений вызывающих ложную остановку поиска!

Цитата

Если, в течение обработки файла JPG, Вы встречаете 0xFF, затем снова байт, отличный от 0 (Я сообщил Вам, что второй байт маркера - не 0) и этот байт не имеет значение маркера (Вы не можете найти маркер, соответствующий этому байту), тогда байт 0xFF, который Вы встретили, должен игнорироваться и пропускаться. (В некоторых JPG-файлах, последовательности последовательных 0xFF - для некоторого заполнения и должны пропускаться)

Вы видите, что всякий раз, когда Вы встречаете 0xFF, Вы проверяете следующий байт и смотрите, имеет ли значение маркера или должно быть пропущено. Что случается, если нам действительно нужно кодировать байт 0xFF в файле JPG как *обычный* байт (не маркер или заполнение)? (Допустим, что нам нужно писать код Хаффмана, который начинается с 11111111 (8 битов 1) на перестановке байтов) Стандарт сообщает, что мы просто делаем следующий байт 0, и пишем последовательность 'FF00' в файл JPG. Так, когда Ваш дешифратор JPG встречает 2-байтовую последовательность 'FF00', он должен рассмотреть ее как обычный байт 0xFF.

разбор идет побайтно, однако... просто та функция, которую я нашел, не учитывает некоторые моменты: такие как exif, thumb'ы итд...

dumb

Дата 26.7.2006, 19:31 (ссылка)

(нет голосов)

Загрузка ...

sceloglauxalbifacies

Профиль
Группа: Экс. модератор
Сообщений: 2929
Регистрация: 16.6.2006

Репутация: нет
Всего: 158

эм. что такое "искомый сегмент" и чем он определяется? и откуда ты взял "размер сегмента" для сдвига? вот в тех "неправильных" картинках по три блока SOF0 - какой из них нужный?

Pavelbej

Дата 26.7.2006, 20:17 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

Наткнулся в сети вот на это. Проверил - вообще не работает.

Код


unit main;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtDlgs,Jpeg;

type
  TForm1 = class(TForm)
    OPD: TOpenPictureDialog;
    OpenFileBtn: TButton;
    FilepathEdt: TEdit;
    Label1: TLabel;
    procedure GetJPGSize(const sFile: string; var wWidth, wHeight: word);
    function ReadMWord(f: TFileStream): word;
    procedure OpenFileBtnClick(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }

  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

{ TForm1 }

procedure TForm1.GetJPGSize(const sFile: string; var wWidth,  wHeight: word);
const
   ValidSig : array[0..1] of byte = ($FF, $D8);
   Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
 var
   Sig: array[0..1] of byte;
   f: TFileStream;
   x: integer;
   Seg: byte;
   Dummy: array[0..15] of byte;
   Len: word;
   ReadLen: LongInt;
 begin
   FillChar(Sig, SizeOf(Sig), #0);
   f := TFileStream.Create(sFile, fmOpenRead);
   try
     ReadLen := f.Read(Sig[0], SizeOf(Sig));
     for x := Low(Sig) to High(Sig) do
       if Sig[x] <> ValidSig[x] then ReadLen := 0;
     if ReadLen > 0 then
     begin
       ReadLen := f.Read(Seg, 1);
       while (Seg = $FF) and (ReadLen > 0) do
       begin
         ReadLen := f.Read(Seg, 1);
         if Seg <> $FF then
         begin
           if (Seg = $C0) or (Seg = $C1) then
           begin
             ReadLen := f.Read(Dummy[0], 3); { don't need these bytes }
             wHeight := ReadMWord(f);
             wWidth := ReadMWord(f);
           end else begin
             if not (Seg in Parameterless) then
             begin
               Len := ReadMWord(f);
               f.Seek(Len-2, 1);
               f.Read(Seg, 1);
             end else
               Seg := $FF; { Fake it to keep looping. }
           end;
        end;
       end;
     end;
   finally
     f.Free;
   end;
 end;

function TForm1.ReadMWord(f: TFileStream): word;
type
   TMotorolaWord = record
     case byte of
       0: (Value: word);
       1: (Byte1, Byte2: byte);
   end;
 var
   MW: TMotorolaWord;
 begin
   { It would probably be better to just read these two bytes in normally }
   { and then do a small ASM routine to swap them.  But we aren't talking }
   { about reading entire files, so I doubt the performance gain would be }
   { worth the trouble. }
   f.Read(MW.Byte2, SizeOf(Byte));
   f.Read(MW.Byte1, SizeOf(Byte));
   Result := MW.Value;
end;

procedure TForm1.OpenFileBtnClick(Sender: TObject);
var
aWidth,aHeigth:Word;
begin
   if OPD.Execute then begin
    FilepathEdt.Text:=OPD.FileName;
    GetJPGSize(opd.FileName,aWidth,aHeigth);
    Label1.Caption:=Format('JPEG Size is %d x %d',[aWidth,aHeigth]);
    end;
end;

end.

Alexeis

Дата 26.7.2006, 21:15 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Код


SOF0: Начало Кадра 0:
$ff, $c0 (SOF0)
длина (старший байт, младший байт), 8+components*3
точность данных (1 байт) в битах/единицу, обычно 8 (12 и 16 не поддерживается большинством программного обеспечения)
высота изображения (2 байта, High-Low), должно быть >0, если DNL не поддерживается
ширина изображения (2 байта, High-Low), должно быть >0, если DNL не поддерживается
количество компонентов (1 байт), обычно 1 = черно-белый, 3 = цвет YCbCr или YIQ, 4 = цвет CMYK)
для каждого компонента: 3 байта
идентификатор компонента (1 = Y, 2 = Cb, 3 = Cr, 4 = I, 5 = Q)
показатели дискретизации (бит 0-3 вертикальной, 4-7 горизонтальной)
номер таблицы квантования

В первой попвшейся картинке JPEG я нашел целых 3 таких сегмена (блока) и только во втором блоке начиная с 3 го байта содержатся высота и ширина

--------------------

Pavelbej

Дата 27.7.2006, 09:27 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

alexeis1, земляк, может поможешь кодом а? smile

а то я

Romikgy

Дата 27.7.2006, 10:15 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: нет
Всего: 146

народ а че вы лисапеды изобретаете, есть же уже написаное в дельфи

Код


uses Jpeg;

procedure TForm1.Button1Click(Sender: TObject);
var jp: TJPEGImage;
begin
jp:=TJPEGImage.Create;
jp.LoadFromFile('d:\K\15.jpg');
Edit1.Text:=IntToStr(jp.Height);
Edit2.Text:=IntToStr(jp.Width);
jp.Free;
end;

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Alexeis

Дата 27.7.2006, 10:22 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Все очень просто делается, читается первый сегмент, проверяется на совпадение с искомым, если не совпадает, то сдвигаемся на размер сегмента до следующего и так далее, пока не найдем нужный, затем в нужном сегменте находится нужная позиция. Сегментная модель не требут знания всех блоков, неидентифицированные блоки просто пропускаются.

Ну и задолбался я smile

, размер сегмента указывается с учетом байтов самого размера, но без учета байтов идентификатора сегмента. Кроме того "SOF0" или Start Of Frame Marker, может обозначатся тремя кодами $01, $02, $03
Т.о. получаем следующий код

Код


function SwapWord(AWord: Word):Word;
var
  TmpByte : Byte;
  TmpWord : Word;
begin
  TmpByte := AWord AND $00FF;
  TmpWord := TmpByte;
  TmpByte := (AWord SHR 8) AND $00FF;
  Result  := (TmpWord SHL 8) + TmpByte;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  f : TFileStream;
  b1, b2 : Byte;
  w : Word;
  wdth, hght : Word;

begin
  if dlgOpen1.Execute
  then
    begin
       f := TFileStream.Create(dlgOpen1.FileName, fmOpenRead or fmShareDenyWrite);
       f.Seek(2, soBeginning);
       w := 2; //для того что бы w - 2 = 0, и не было никакого смещеня поскольку
       repeat  //первый сегмент идет сразу за идентификатором Jpeg
          f.Seek(w - 2, soFromCurrent); //Сдвиг к началу следующего сегмента
          f.ReadBuffer(b1, 1);  //чтение идентификаторов
          f.ReadBuffer(b2, 1);  //сегмента
          f.ReadBuffer(w, 2);  //чтение размера сегмена - длинна идентификатора (2 байта)
          w := SwapWord(w);  //Инвертирование порядка байтов (в jpeg принят обратный порядок)
       until ((b1 = $FF) and (b2 in [$C0, $C1, $C2])) or //Проверка является ли сегмент сегменом SOF0
               ((f.Position + w + 4) > f.Size); //На случай отсутствия сегмента (в jpeg присутствует всегда)

       if (f.Position + w + 4) > f.Size //Если отсутствут выходим
       then
         Begin
           ShowMessage('fail');
           Exit;
         end;

       f.Seek(1, soFromCurrent);  //байт формата точности (не нужен)
       f.ReadBuffer(hght, 2);         //чтение высоты
       f.ReadBuffer(wdth, 2);        //чтение ширины
       hght := SwapWord(hght); //Инвертирование порядка байтов (в jpeg принят обратный порядок)
       wdth := SwapWord(wdth); //Инвертирование порядка байтов (в jpeg принят обратный порядок)

       ShowMessage(intToStr(wdth) + 'x' + intToStr(hght));
       f.Free;
    end;
end;

Данный код правельно определяет парметры у всех jpeg (и у указанных в 1.rar тоже)
Как показал просмотр данные изображения имели дополнительные сегменты(содержащие данные о производителе фотографии). В них содержалась произвольная информация (нерегламентированая ) которая совпадала с комбинацией $FFC0, что и приводило к ложному опознованию такой информации как сегменом SOF0.
Кроме того данный код имеет колосальное приемущество в скорости, поскольку не сканирует все байты подряд, а читает только выборочные (идентификаторы и размеры сегментов). И конечно же не грузит и не декодирует файл целиком. smile

Добавлено @ 10:31

Цитата(Romikgy @ 27.7.2006, 10:15

)

народ а че вы лисапеды изобретаете, есть же уже написаное в дельфи

Вопервых делфийский компанент не загружает все типы изображений, во вторых, если он это и сделает то с какой скоростью! Если картинка будет 3000х2000, он же несколько секунд грузить ее будет, и все ради чего чтобы узнать лишь ее разрешение!

--------------------

Romikgy

Дата 27.7.2006, 10:47 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: нет
Всего: 146

Цитата(alexeis1 @ 27.7.2006, 09:22

)

Как знаете

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Alexeis

Дата 27.7.2006, 10:56 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(Romikgy @ 27.7.2006, 10:47

)

Как знаете

Дело в том, что уже были проблемы с ним и не раз. А свой код я писал, разобравшись в оригинальной документации по jpeg ITU - 1150 (INFORMATION TECHNOLOGY – DIGITAL COMPRESSION AND CODING OF CONTINUOUS-TONE STILL IMAGES – REQUIREMENTS AND GUIDELINES)

--------------------

Pavelbej

Дата 3.8.2006, 18:22 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

alexeis1, вот еще одна "неправильная" картинка.

img

Alexeis

Дата 3.8.2006, 20:18 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Что сказать, картинка и вправду неподарок, однако, она таки соответствует стандатру. Имеется ондна маленькая слабинка, которая прилично усложняет просмотр!

Цитата

Any marker may optionally be preceded by number of fill bytes, which are bytes assigned code X’FF’.

Цитата

NOTE – Because of this special code-assignment structure, markers make it possible for a decoder to parse the compressed data and locate its various parts without having to decode other segments of image data.

Причем первая часть противеречит второй, так как допускает перед началом сегмента баласт ("number of fill bytes"), длинна которого неопределенна. Это как раз и произошло в данном случае.

Посмотрим на картинку ВинХекса:
user posted image

на картинке виден пустой блок, который необходимо обойти.
---------------------------------------------------------------------------------------------------------------
Вот код добавил код обхода
теперь распознает и эту картинку

Код


function SwapWord(AWord: Word):Word;
var
  TmpByte : Byte;
  TmpWord : Word;
begin
  TmpByte := AWord AND $00FF;
  TmpWord := TmpByte;
  TmpByte := (AWord SHR 8) AND $00FF;
  Result  := (TmpWord SHL 8) + TmpByte;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  f : TFileStream;
  b1, b2 : Byte;
  w : Word;
  wdth, hght : Word;

begin
  if dlgOpen1.Execute
  then
    begin
       f := TFileStream.Create(dlgOpen1.FileName, fmOpenRead or fmShareDenyWrite);
       f.Seek(2, soBeginning);
       w := 2;
       repeat
          f.Seek(w - 2, soFromCurrent);
          f.ReadBuffer(b1, 1);
          f.ReadBuffer(b2, 1);

          //Обход баластных блоков
          if (b1 <> $FF) or (b2 = $00) or (b2 = $FF)
          then
            Begin
              repeat
                f.Position := f.Position - 1;
                f.ReadBuffer(b1, 1);
                f.ReadBuffer(b2, 1);
              until ((f.Position + 2) > f.Size) or
                    ((b1 = $FF) and (b2 <> $00) and (b2 <> $FF));

              if (f.Position + 2) > f.Size
              then
                Break
            end;

          f.ReadBuffer(w, 2);
          w := SwapWord(w);
       until ((b1 = $FF) and (b2 in [$C0, $C1, $C2])) or ((f.Position + w + 4) > f.Size);

       if (f.Position + w + 4) > f.Size
       then
         Begin
           ShowMessage('fail');
           Exit;
         end;

       f.Seek(1, soFromCurrent);
       f.ReadBuffer(hght, 2);
       f.ReadBuffer(wdth, 2);
       hght := SwapWord(hght);
       wdth := SwapWord(wdth);

       ShowMessage(intToStr(wdth) + 'x' + intToStr(hght));
       f.Free;
    end;
end;

--------------------

Pavelbej

Дата 4.8.2006, 00:14 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

alexeis1, огромное спасибо но вот что я еще нашел:

Image

И что интересно так это то, что моя прога даже не отображает эту картинку, а уж про разрешение и не говорю.

Это сообщение отредактировал(а) Pavelbej - 4.8.2006, 00:17

Alexeis

Дата 4.8.2006, 00:32 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(Pavelbej @ 4.8.2006, 00:14

)

И что интересно так это то, что моя прога даже не отображает эту картинку

Конечно это же переименованная PNG - шка smile

Добавлено @ 00:34
Код jpg - FF D8
А тут 89 50 4E 47

50 4E 47 - в аски формате - "PNG"

--------------------

Pavelbej

Дата 4.8.2006, 00:58 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 419
Регистрация: 5.7.2005

Репутация: нет
Всего: 6

Вот тормоз! Мне ее тут на форуме подкинули, извини. smile

Alexeis

Дата 4.8.2006, 01:14 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Цитата(Pavelbej @ 4.8.2006, 00:58

)

Вот тормоз! Мне ее тут на форуме подкинули, извини.

На самом деле не так просто определить что это такое, ACDSEE, который любит ругатся на любое несоответствие формата, молча отобразил как будто так и надо. WINHEX - в таких вещах здорово помогает. Открыл и сразу видно, заголовку. Вообще програмы графического просмотра явно расширение игнорируют и по заголовку судят.

--------------------

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »