Отправляет email-рассылки с помощью сервиса Sendsay

Мастера DELPHI. Новости мира компонент, FAQ, статьи...

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Август 2002   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

13.577 подписчиков
-18 за неделю
←   Все выпуски   →

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Информационный Канал Subscribe.Ru
Ежедневная рассылка сайта Мастера DELPHI

DELPHI.mastak.ru

Выпуск от 31.08.02 09:04

Лучшее из нашего FAQ   |x|
Как определить размеры jpeg, gif, png
Вот вам процедуры, но они могут не работать с последними форматами типа progressive JPEG

unit ImgSize;

interface

uses Classes;

procedure GetJPGSize(const sFile: string; var wWidth, wHeight: word);
procedure GetPNGSize(const sFile: string; var wWidth, wHeight: word);
procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: word);

implementation

uses SysUtils;

function 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 b!
e worth the trouble.}
  f.Read(MW.Byte2, SizeOf(Byte));
  f.Read(MW.Byte1, SizeOf(Byte));
  Result := MW.Value;
end;

procedure 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;

procedure GetPNGSize(const sFile: string; var wWidth, wHeight: word);
type

 TPNGSig = array[0..7] of byte;
const
  ValidSig: TPNGSi!
g = (137,80,78,71,13,10,26,10);
var
  Sig: TPNGSig;
  f: tFileStream;
  x: integer;
begin
  FillChar(Sig, SizeOf(Sig), #0);
  f := TFileStream.Create(sFile, fmOpenRead);
  try
    f.Read(Sig[0], SizeOf(Sig));
    for x := Low(Sig) to High(Sig) do
    if Sig[x] <> ValidSig[x] then exit;
    f.Seek(18, 0);
    wWidth := ReadMWord(f);
    f.Seek(22, 0);
    wHeight := ReadMWord(f);
  finally
    f.Free;
  end;
end;

procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: word);
type
  TGIFHeader = record
  Sig: array[0..5] of char;
  ScreenWidth, ScreenHeight: word;
  Flags, Background, Aspect: byte;
end;
  TGIFImageBlock = record
  Left, Top, Width, Height: word;
  Flags: byte;
end;
var

 f: file;
  Header: TGifHeader;
  ImageBlock: TGifImageBlock;
  nResult!
: integer;
  x: integer;
  c: char;
  DimensionsFound: boolean;
begin
  wWidth  := 0;
  wHeight := 0;
  if sGifFile = '' then
  exit;

  {$I-}

  FileMode := 0; { read-only }
  AssignFile(f, sGifFile);
  reset(f, 1);
  if IOResult <> 0 then
  {Could not open file}
  exit;
  {Read header and ensure valid file.}
  BlockRead(f, Header, SizeOf(TGifHeader), nResult);
  if (nResult <> SizeOf(TGifHeader)) or (IOResult <> 0) or
  (StrLComp('GIF', Header.Sig, 3) <> 0) then begin
    {Image file invalid}
    close(f);
    exit;
  end;
  {Skip color map, if there is one}
  if (Header.Flags and $80) > 0 then begin
    x := 3 * (1 SHL ((Header.Flags and 7) + 1));
    Seek(f, x);
    if IOResult <> 0 then begin

     { Color map thrashed }
      close(f);
      exit;
    end;
  end;
  DimensionsFound := False;
  FillChar(ImageBlock, SizeOf(TGIFImageBlock), #0);
  { Step through blocks. }
  BlockRead(f, c, 1, nResult);
  while (not EOF(f)) and (not DimensionsFound) do begin
    case c of
    ',': { Found image }
    begin
      BlockRead(f, ImageBlock, SizeOf(TGIFImageBlock), nResult);
      if nResult <> SizeOf(TGIFImageBlock) then begin
        { Invalid image block encountered }
        close(f);
        exit;
      end;
      wWidth  := ImageBlock.Width;
      wHeight := ImageBlock.Height;
      DimensionsFound := True;
    end;
    'я' : { Skip }
    begin
      { NOP }
    end;
    { nothing else, just ignore }
  end;
  BlockRead(f, c, 1, nResult);
end;
close(f);

{$I+}

end;
end.

»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
  • Прорисовка при скроллинге в StringGrid'e
  • Модальные окна
    Как сделать, чтобы внешний открытый файл, а точнее окно, стало модальным для главной формы моей проги
  • Inage и ListView
    Как в Ран-Тайме отображать и убирать иконки в ЛистВью? Поясняю: необходимо постоянно то отображать иконки, то убирать ...
  • Модель безопасности ?
    Уважаемые подскажите пожалуйста! Необходимо в базе в небольшой торговой организации (склад+торговые ...
  • Decompilator
    У кого есть обратный компилятор для Delphi 6.Отправте на мой E-mail.
  • Экспорт из StringList в Excel 97/2000
    Народ, подскажите как перенести данные из StringList в Excel 97/2000.
  • Delphi+sql server 7.0
    Привет мастерам! Объясните, пожалуйста, что за трюк: SQL server-> Enterprize manager->query analizer на запрос ...
У нас большой выбор статей   |x|
Перевод и адаптация под DELPHI раздела Win32 SDK посвященного клавиатурным курсорам
Поскольку только одно окно может иметь в данный момент фокус ввода (быть активным), то в системе может быть только один курсор. Каждое окно, содержащее курсор, должно создавать его при получении фокуса, и освобождать при потере фокуса.
Все программы, написанные под Microsoft® Windows® могут создавать курсоры, отображать или скрывать их, перемещать их, а также изменять время мерцания...
Новинки книжного рынка   |x|
Delphi 5 для профессионалов
Эта книга поможет вам овладеть программированием в Delphi, включая язык Object Pascal, компоненты Delphi (как работу с существующими компонентами, так и разработку ваших собственных), поддержку баз данных и приложений клиент/сервер, базовые элементы программирования в среде Windows и разработку COM-приложений, а также Web-программирование. Для чтения этой книги нет необходимости в глубоких знаниях какой-либо из этих тем, но что вам действительно понадобится — это основы программирования на Паскале.
Автор: М. Кэнту
Другие сайты о DELPHI   |x|
SMExport, SMImport, SMReport Designer, SMLogging и другие компоненты
Всегда последние версии наших продуктов. Огромный набор бесплатных компонент и примеров. Статьи, links, tips, mailing list
» Оценка сайта: 3
Опрос населения :)
Стоит ли устраивать встречи программистов в реале? (пирушки :)
»»» Обязательно!
»»» Иногда можно
»»» Я туда не пойду
»»» Категорически нет
Журнал "RSDN Magazine"  |x|

Дорогие друзья! Мы рады представить вам новый совместный проект сайтов www.rsdn.ru, delphi.mastak.ru и www.optim.ru - профессиональный журнал для программистов RSDN Magazine.
Несомненно, ваше мнение о необходимости такого журнала, содержании рубрик и темах отдельных статей поможет сделать журнал более полезным и интересным. Высказать свое мнение, проголосовать или же подписаться вы можете на сайте. Без вашего участия, нам будет трудно сделать правильный журнал!
На сайте выложен анонс пилотного выпуска журнала, вступительное слово от редакции.

Для души

Хокку дня
Часто в весеннем лесу
Пил Рихард Зорге бамбуковый сок
И матом по-русски ругался...

Афоризмы
Лишь один человек знает, о чем думаю я... да и тот безумен!...

Фраза дня
Последний раз я его видел на фотографии.

Дурацкие законы (информация предоставлена сайтом kurilka.com)
Во Франции запрещается целоваться на железнодорожных путях.
В Сэнт Луисе (США) запрещается сидеть на мостовой и распивать пиво из ведра.

И на закуску коротенький анекдот
Армянское радио спрашивают:
- Можно ли принимать женщин в компьютерный клуб?
- Можно. Если женщина не боится мышей и не краснеет от слова "АВОRТ".

Фотоприколы.
Начните день с хорошего настроения!
http://delphi.mastak.ru/cgi-bin/prikol.pl?id=32

На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (delphi@mastak.com)

Добро пожаловать на сайт -= Мастера DELPHI =- 
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное