Приветствую Вас Гость | RSS

Меню сайта

Реклама

Категории раздела
Bitmap [50]
Canvas [0]
DirectX и DelphiX [39]
GIF [3]
ICO [24]
JPEG [14]
MetaFile [6]
OpenGL [9]
ScreenSaver и ScreenMate [13]
Векторная графика [2]
Графика [37]
Изображения [0]
Картография [6]
Компоненты и Графика [0]
Создание игр [17]
Цвета и Палитра [0]
Шрифты [0]

Наш опрос
Есть ли у Вас свой сайт?
Всего ответов: 48

Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

Форма входа

Главная » Статьи » Графика и Игры » JPEG

Получить или установить разрешение JPEG
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' + #0$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;

procedure SetResJpg(name: string; dpix, dpiy: Integer);
const
BufferSize = 50;
DPI = 1; //inch
DPC = 2; //cm
var
Buffer: string;
index: INTEGER;
FileStream: TFileStream;
xResolution: WORD;
yResolution: WORD;
_type: Byte;
begin
FileStream := TFileStream.Create(name,
fmOpenReadWrite);
try
SetLength(Buffer, BufferSize);
FileStream.Read(buffer[1], BufferSize);
index := POS('JFIF' + #0$00,buffer);
if index > 0
then begin
FileStream.Seek(index + 6, soFromBeginning);
_type := DPI;
FileStream.write(_type, 1);
xresolution := swap(dpix);
FileStream.write(xresolution, 2);
yresolution := swap(dpiy);
FileStream.write(yresolution, 2);
end
finally
FileStream.Free;
end;
end;
Категория: JPEG | Добавил: Skinner (09.07.2008)
Просмотров: 429 | Рейтинг: 0.0/0
  Delphi Lab   Главная   Регистрация   Вход  
Интересная Цитата

Поиск

Магазин


Copyright MyCorp © 2025 Хостинг от uCoz