Библиотеки По Работе С Гиф

Тема в разделе "Delphi - FAQ", создана пользователем Vadik(R), 28 фев 2012.

  1. Vadik(R)

    Vadik(R) Well-Known Member

    Регистрация:
    12 дек 2007
    Сообщения:
    483
    Симпатии:
    0
    Добрый вечер!

    Стоит следующая задача. Нужно несколько картинок объединить в анимированный гиф-файл, с возможностью задания времени задержки и числа повторений. Сохранять должен в самом расширенном цветовом диапозоне, т.е. мне не сильно важен размер, важно лишь, чтобы получилась анигифка без потери качества. Сам читал про гиф89а, но что-то запутался про то, как там используется глобальная/локальная палитра, про LZW-алгоритм сжатия (его везде предлагают почитать отдельно, и везде предлагают его ещё сильнее оптимизировать, поэтому какой именно вариант LZW применяется в гифках я не знаю), да и времени разбираться особо нет.

    Поэтому прошу понакидать готовых библиотек под Delphi 7 для работы с гиф-файлом, хочу на вход давать картинки в виде массивов ргб, задержки и количество повторений, а на выходе иметь ани гифку :)

    Заранее спасибо!
     
  2. sinkopa

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    Миссия невыполнима... B)
    Поясняю:
    1. Цветовая гифа может содержать не более 256 цветовых элементов.
    Говорю "элементов" (а не цветов) потому как это могут быть любые 256 цветов из палитры TrueColor (16 777 216).
    К примеру это может быть 256 градаций только синего цвета.
    2. Изображение (битовая карта) гифа представляет из себя массив ссылок на элементы палитры. (т.е. картинка не может содержать цветовые пиксели которых в палитре нет)
    3. Глобальная палитра анимационного гифа - это единая палитра на ВСЕ гиф картинки в анимации. (т.е. не более 256 цветовых элементов НА ВСЕ картинки в анимации).
    4. Локальная палитра содержит массив ссылок на элементы (цвета) глобальной палитры которые следует считать прозрачными.
    Есть правда некоторые варианты... но (для простоты понимания сути) их опустим...
    Короче... Применительно к поставленной Вами задаче:
    Допустим есть две гиф картинки. red.gif 1-я содержит палитру в 256 красного, blue.gif 2-я 256 градаций синего.
    Объединить их в 1 анимационный гиф с двумя кадрами можно только 1-м способом:
    1. Урезать палитру каждого рисунка до 128 цветов
    2. Заполнить Глобальную палитру: 128 градаций красного и 128 синего.
    Как вы понимаете (надеюсь) качество обоих кадров упадет ровно в два раза...
    А если третьим кадром нужно будет вставить зеленую картину...
    Нужно дальше объяснять? :)

    В общем, я думаю что для реализации указанной Вами задачи анимационный гиф не годится.
    Нужно другое решение... например AVI или SWF.
    См выше... :)
    Гиф прекрасно "живет" и без всякого сжатия... К тому же не все "устройства" воспроизведения гифок (браузеры, смотрелки) умеют работать с LZW.
    Это можно... Ну вот например:
    1. torry.net > Components > Graphics > GIF Images
    2. TGIFImage 3 (for Delphi)
    TGIFImage 3 Animation Demo (34.99 KB)
    3. Working with GIF images in Delphi
    Хватит? :)
     
  3. Vadik(R)

    Vadik(R) Well-Known Member

    Регистрация:
    12 дек 2007
    Сообщения:
    483
    Симпатии:
    0
    sinkopa, большое спасибо! Не ожидал увидеть такой подробный ответ!

    Этого нигде не нашёл.

    Я вначале думал так, что есть глобальная палитра наиболее часто используемых цветов, а есть локальные маленькие палитры к картинкам для недостающих цветов в глобальной палитре. Но ошибся. Просто получилось так, что сделал gif-ку во Flash'е, сохранил её, а её качество было ужасным, как бы я не игрался с настройками. Потом нашёл, как делать анигифки в фотошопе, сохраняю - качество вообще не потерялось. Я в шоке. Видимо фотошоп просто умный и сам подставил подходящую палитру. А если цветов было больше 256, то он некоторые ужал.

    Решения хорошие, но нужна именно картинка.

    Поэтому пункту чуть попозже будут вопросы, надо будет мне ещё раз разобраться со структурой гиф. И ссылки посмотреть.
     
  4. Vadik(R)

    Vadik(R) Well-Known Member

    Регистрация:
    12 дек 2007
    Сообщения:
    483
    Симпатии:
    0
    Итак, решил я всё-таки писать свою программу для сохранения в gif. Структуру файла читал здесь, но как всегда, дошёл до LZW-алгоритма и застрял.

    Собственно, прилагаю и код и проект:
    Код (Delphi):
    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, XPMan, ExtCtrls, StdCtrls, ComCtrls;

    type
    TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    TrackBar4: TTrackBar;
    Edit1: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
    procedure TrackBar4Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;
    Clicked: Boolean;

    implementation

    {$R *.dfm}

    function ToHex(x: Integer): AnsiString;
    var
    i: Integer;
    begin
    result := '';
    for i := 1 to 2 do
    begin
    case x mod 16 of
    0: result := '0' + result;
    1: result := '1' + result;
    2: result := '2' + result;
    3: result := '3' + result;
    4: result := '4' + result;
    5: result := '5' + result;
    6: result := '6' + result;
    7: result := '7' + result;
    8: result := '8' + result;
    9: result := '9' + result;
    10: result := 'a' + result;
    11: result := 'b' + result;
    12: result := 'c' + result;
    13: result := 'd' + result;
    14: result := 'e' + result;
    15: result := 'f' + result;
    end;
    x := x shr 4;
    end;
    end;

    procedure Paint1;
    begin
    Form1.Image2.Canvas.Brush.Color := Form1.TrackBar1.Position + Form1.TrackBar2.Position shl 8 + Form1.TrackBar3.Position shl 16;
    Form1.Image2.Canvas.FillRect(Form1.Image2.ClientRect);
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    var
    i: Integer;
    Path: AnsiString;
    begin
    Image1.Canvas.Brush.Color := $ffffff;
    Image1.Canvas.FillRect(Form1.Image1.ClientRect);
    Image2.Canvas.Brush.Color := $000000;
    Image2.Canvas.FillRect(Form1.Image2.ClientRect);
    Path := Application.ExeName;
    i := Length(Path);
    while Path[i] <> '\' do
    begin
    i := i - 1;
    end;
    Delete(Path, i + 1, Length(Path) - i);
    Edit1.Text := Path + 'tiz.gif';
    end;

    procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
    Clicked := True;
    end;

    procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    var
    i, j: Integer;
    begin
    if Clicked then
    begin
    for i := -TrackBar4.Position to TrackBar4.Position do
    begin
    for j := -TrackBar4.Position to TrackBar4.Position do
    begin
    Image1.Canvas.Pixels[X + i, Y + j] := TrackBar1.Position + TrackBar2.Position shl 8 + TrackBar3.Position shl 16;
    end;
    end;
    end;
    end;

    procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
    Clicked := False;
    end;

    procedure TForm1.TrackBar1Change(Sender: TObject);
    begin
    Label1.Caption := 'Red: ' + IntToStr(TrackBar1.Position) + ' (' + ToHex(TrackBar1.Position) + ')';
    Paint1;
    end;

    procedure TForm1.TrackBar2Change(Sender: TObject);
    begin
    Label2.Caption := 'Green: ' + IntToStr(TrackBar2.Position) + ' (' + ToHex(TrackBar2.Position) + ')';
    Paint1;
    end;

    procedure TForm1.TrackBar3Change(Sender: TObject);
    begin
    Label3.Caption := 'Blue: ' + IntToStr(TrackBar3.Position) + ' (' + ToHex(TrackBar3.Position) + ')';
    Paint1;
    end;

    procedure TForm1.TrackBar4Change(Sender: TObject);
    begin
    Label4.Caption := 'Толщина: ' + IntToStr(TrackBar4.Position);
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    const
    Block = 4 * 1024;
    var
    Buffer: Integer;
    Bytes: DWORD;
    Colors: array [1..256, (red, green, blue)] of Byte;
    Content: array [1..Block] of Byte;
    F: THandle;
    Flags: Byte;
    i, j, k, n: Integer;
    w: Word;
    begin
    F := CreateFile(PChar(Edit1.Text), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    //Пишем заголовок, 6 байт
    Buffer := Length('GIF89a');
    for i := 1 to Buffer do
    begin
    Content[i] := Ord('GIF89a'[i]);
    end;
    WriteFile(F, Content, Buffer, Bytes, nil);
    //Пишем длину изображения, 2 байта
    WriteFile(F, Image1.Width, SizeOf(Word), Bytes, nil);
    //Пишем высоту изображения, 2 байта
    WriteFile(F, Image1.Height, SizeOf(Word), Bytes, nil);
    //Пишем флаги
    //Бит 7 - наличие глобальной палитры
    //Биты 4-6 - количество битов на цвет
    //По сути качество картинки, нам нужно всегда максимальное
    //Бит 3 - флаг сортировки палитры, обычно стоит ноль
    //Биты 0-2 - размер палитры, если бит 7 - ноль, то всё зануляется
    //Вот это дело можно оптимизировать, смотря какое количество цветов
    Flags := Flags or $80;
    Flags := Flags or $40 or $20 or $10;
    Flags := Flags or $08 xor $08;
    Flags := Flags or $04 or $02 or $01;
    WriteFile(F, Flags, SizeOf(Byte), Bytes, nil);
    //Пишем номер цвета фона, 1 байт
    //Если при этом в самом первом расширении управления графикой включена прозрачность
    //То этот цвет считается прозрачным
    //Пускай номер цвета фона - белый
    //Рекомендуется ставить первые два цвета в палитре - чёрный и белый
    Flags := $01;
    WriteFile(F, Flags, SizeOf(Byte), Bytes, nil);
    //Пишем зарезервированный флаг, который обычно ставят в ноль, 1 байт
    Flags := $00;
    WriteFile(F, Flags, SizeOf(Byte), Bytes, nil);
    //Пишем глобальную палитру
    //Для этого соберём все цвета с картинки (предполодим, что вначале их у нас меньше 254)
    //Не забываем, первый и второй цвета - чёрный и белый
    FillChar(Colors, SizeOf(Colors), 0);
    n := 2;
    Colors[n, red] := $ff;
    Colors[n, green] := $ff;
    Colors[n, blue] := $ff;
    for i := 0 to Image1.Height - 1 do
    begin
    for j := 0 to Image1.Width - 1 do
    begin
    Flags := 0;
    for k := 1 to n do
    begin
    if Colors[k, red] + Colors[k, green] shl 8 + Colors[k, blue] shl 16 = Image1.Canvas.Pixels[j, i] then
    begin
    Flags := 1;
    Break;
    end;
    end;
    if Flags = 0 then
    begin
    n := n + 1;
    Colors[n, red] := (Image1.Canvas.Pixels[j, i] and $ff);
    Colors[n, green] := (Image1.Canvas.Pixels[j, i] and $ff00) div $100;
    Colors[n, blue] := (Image1.Canvas.Pixels[j, i] and $ff0000) div $10000;
    end;
    end;
    end;
    for i := 1 to 256 do
    begin
    WriteFile(F, Colors[i, red], SizeOf(Byte), Bytes, nil);
    WriteFile(F, Colors[i, green], SizeOf(Byte), Bytes, nil);
    WriteFile(F, Colors[i, blue], SizeOf(Byte), Bytes, nil);
    end;
    //Пишем символ запятой, 1 байт
    Flags := Ord(',');
    WriteFile(F, Flags, SizeOf(Byte), Bytes, nil);
    //Пишем левый угол логического экрана - 2 байта
    w := 0;
    WriteFile(F, w, SizeOf(Word), Bytes, nil);
    //Пишем верхний угол логического экрана - 2 байта
    w := 0;
    WriteFile(F, w, SizeOf(Word), Bytes, nil);
    //Пишем длину изображения, 2 байта
    WriteFile(F, Image1.Width, SizeOf(Word), Bytes, nil);
    //Пишем высоту изображения, 2 байта
    WriteFile(F, Image1.Height, SizeOf(Word), Bytes, nil);
    //Пишем флаги
    //Бит 7 - наличие локальной палитры
    //Бит 6 - черезстрочная или обычная развёртка
    //Хз, какое состояние флага за что отвечает
    //Предположим, что
    //0 - обычная развёртка
    //1 - черезстрочная
    //По сути качество картинки, нам нужно всегда максимальное
    //Бит 5 - флаг сортировки палитры, обычно стоит ноль
    //Биты 3-4 - стоят зарезервированные нули
    //Биты 0-2 - размер локальной палитры
    //Вот это дело можно оптимизировать, смотря какое количество цветов
    Flags := Flags or $80 xor $80;
    Flags := Flags or $40 xor $40;
    Flags := Flags or $20 xor $20;
    Flags := Flags or $10 xor $10 or $08 xor $08;
    Flags := Flags or $04 or $02 or $01;
    WriteFile(F, Flags, SizeOf(Byte), Bytes, nil);
    //Описываем изображение
    //Пишем начальный размер LZW-кода, 1 байт
    //Равен глубине цвета картинки
    //За исключением двухцветных, когда MC равен не 1, а 2
    Flags := $08;
    WriteFile(F, Flags, SizeOf(Byte), Bytes, nil);
    //Пишем размер субблока данных, 1 байт
    //Вначале идут 255, последний - любой от 1 до 255
    //Если предыдущие пункты кое-как понятны, то тут запарка...
    //Пошли копать структуру изображения
    CloseHandle(F);
    end;

    begin
    Clicked := False;
    end.
    Очень хочется увидеть просто подробную структуру гиф-файла. С объяснением, что вот у нас не анимированное изображение (для простоты), давайте его закодируем. И пишутся всё подряд: флаги, палитры и собственно, сами ссылки на палитру (сейчас именно здесь и ступор).

    P.S. Кстати, про 256 цветов. Википедия пишет:
    Посмотреть вложение Gif_Creator.rar
     
  5. sinkopa

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    Похвальное упорство... :)
    Вопрос Ваш уточните пожалуйста...
    Я так понимаю... Раз Вы читали эти статьи:
    Краткое описание формата GIF
    Сжатие по методу LZW
    то Вам должен быть понятен процесс записи данных в формате GIF.
    В чем вопрос то? Слова "застрял" и "ступор" как-то не тянут на вопрос, уж извините...
     
  6. Vadik(R)

    Vadik(R) Well-Known Member

    Регистрация:
    12 дек 2007
    Сообщения:
    483
    Симпатии:
    0
    Застрял я именно из-за того, что довольно сложно изучать структуру файла hex-редакторами, а автор приводит структуру gif и алгоритм LZW в двух разных статьях. Много существует вариаций алгоритма LZW, поэтому какая именно из них применяется в gif-файле - я не знал. Помогла вот эта статья.
    Кстати, я бы ни за что не догадался вот об этом:
    Так что вопросов пока нету ;)
     
Загрузка...

Поделиться этой страницей