Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Звук, графика и видео > Разрешение изображения


Автор: Pavelbej 25.7.2006, 23:01
В листбокс-е находятся изображения (путь и имя файла).  Этот код (создание 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
А нельзя ли просто 
Image1.Picture.LoadFromFile(ListBox1.Items[ListBox1.itemindex]);
GetBitmapDimensionsString(Image1.Picture.Bitmap); 

Автор: Alexeis 26.7.2006, 10:01
Вот самый быстрый способ
Код

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;
 

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

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

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

Автор: Pavelbej 26.7.2006, 14:26
Покажи пример пожалуйста.  И прокоментируй код если тебе не трудно а то для меня это вче ново. 

Автор: Romikgy 26.7.2006, 14:58
TJPEGImage не?
в нем есть и высота и ширина smile 

Автор: dumb 26.7.2006, 15:05
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
Цитата(Pavelbej @  26.7.2006,  14:26 Найти цитируемый пост)
 И прокоментируй код если тебе не трудно а то для меня это вче ново. 

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

Автор: Pavelbej 26.7.2006, 16:37
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
покажи(прикрепи, выложи куда-нибудь) пару файлов, у которых неправильно отображается разрешение. 

Автор: Pavelbej 26.7.2006, 17:02
Вот эти например не отображались правильно:

http://www.vscsoftware.com/download/1.rar 

Автор: Alexeis 26.7.2006, 17:11
Цитата(Pavelbej @  26.7.2006,  16:37 Найти цитируемый пост)
Посмотрите может измените код чтобы узнать горизонтальный и вертикальный размер изображения в пикселях:

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

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

Автор: dumb 26.7.2006, 17:48
Цитата(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
эм. что такое "искомый сегмент" и чем он определяется? и откуда ты взял "размер сегмента" для сдвига? вот в тех "неправильных" картинках по три блока SOF0 - какой из них нужный? 

Автор: Pavelbej 26.7.2006, 20:17
Наткнулся в сети вот на это. Проверил - вообще не работает. 

Код

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
Код

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
alexeis1,  земляк, может поможешь кодом а?  smile  а то я   smile  

Автор: Romikgy 27.7.2006, 10:15
народ а че вы лисапеды изобретаете, есть же уже написаное в дельфи
Код

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

Ну и задолбался я 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
Цитата(alexeis1 @  27.7.2006,  09:22 Найти цитируемый пост)
Вопервых делфийский компанент не загружает все типы изображений, во вторых, если он это и сделает то с какой скоростью! Если картинка будет 3000х2000, он же несколько секунд грузить ее будет, и все ради чего чтобы узнать лишь ее разрешение! 

Как знаете 

Автор: Alexeis 27.7.2006, 10:56
Цитата(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
alexeis1,  вот еще одна "неправильная" картинка.

http://www.vscsoftware.com/166.jpg

Автор: Alexeis 3.8.2006, 20:18
Что сказать, картинка и вправду неподарок, однако, она таки соответствует стандатру. Имеется ондна маленькая слабинка, которая прилично усложняет просмотр!
Цитата

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
alexeis1,  огромное спасибо но вот что я еще нашел:

http://www.vscsoftware.com/Background.jpg

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

Автор: Alexeis 4.8.2006, 00:32
Цитата(Pavelbej @  4.8.2006,  00:14 Найти цитируемый пост)
И что интересно так это то, что моя прога даже не отображает эту картинку

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

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

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

Автор: Pavelbej 4.8.2006, 00:58
Вот тормоз! Мне ее тут на форуме подкинули, извини. smile 

Автор: Alexeis 4.8.2006, 01:14
Цитата(Pavelbej @  4.8.2006,  00:58 Найти цитируемый пост)
Вот тормоз! Мне ее тут на форуме подкинули, извини. 

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

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)