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

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 го байта содержатся высота и ширина

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

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

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

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

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: Звук, графика и видео \| Следующая тема »