Модераторы: Snowy, Alexeis, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Разрешение изображения, Как узнать? 
:(
    Опции темы
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;
 
PM MAIL   Вверх
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); 


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Alexeis
Дата 26.7.2006, 10:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 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 вечная память.

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Pavelbej
Дата 26.7.2006, 13:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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

В чем причина может быть? 
PM MAIL   Вверх
Alexeis
Дата 26.7.2006, 13:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 55
Всего: 459
Pavelbej, Этот код работает только для BMP. Для JPG надо устанавливать другое смещение 


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Pavelbej
Дата 26.7.2006, 14:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 6
Покажи пример пожалуйста.  И прокоментируй код если тебе не трудно а то для меня это вче ново. 
PM MAIL   Вверх
Romikgy
Дата 26.7.2006, 14:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


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


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

Репутация: нет
Всего: 146
TJPEGImage не?
в нем есть и высота и ширина smile 


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
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}
 
PM MAIL   Вверх
Alexeis
Дата 26.7.2006, 16:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 55
Всего: 459
Цитата(Pavelbej @  26.7.2006,  14:26 Найти цитируемый пост)
 И прокоментируй код если тебе не трудно а то для меня это вче ново. 

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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
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; 

 
PM MAIL   Вверх
dumb
Дата 26.7.2006, 16:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


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

Репутация: нет
Всего: 158
покажи(прикрепи, выложи куда-нибудь) пару файлов, у которых неправильно отображается разрешение. 
PM MAIL   Вверх
Pavelbej
Дата 26.7.2006, 17:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 6
Вот эти например не отображались правильно:

image 
PM MAIL   Вверх
Alexeis
Дата 26.7.2006, 17:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
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'ы итд... 
PM MAIL   Вверх
dumb
Дата 26.7.2006, 19:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


sceloglauxalbifacies
****


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

Репутация: нет
Всего: 158
эм. что такое "искомый сегмент" и чем он определяется? и откуда ты взял "размер сегмента" для сдвига? вот в тех "неправильных" картинках по три блока SOF0 - какой из них нужный? 
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0876 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.