VPF::Delphi & Adobe Photoshop Color File Format - Форум программистов

SKIF52

Дата 6.7.2005, 21:45 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

Никто не сталкивался с такой проблемой :

необходимо каким-то образом расшифровать файлы Photoshop с расширением *.aco.

Это файлы цветовых палитр. т.е. хочется выудить из них массив с цветами в RGB.

вот по этой ссылке http://www.nomodes.com/aco.html есть кое-что, но все равно никак не осилю ((

p0s0l

Дата 6.7.2005, 22:59 (ссылка)

(нет голосов)

Загрузка ...

Г-н Посол

Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

Репутация: 16
Всего: 112

Вот накидал на скорую руку, код некрасиво-туповатый, нет конвертирования Lab и HSB цветов (поищи сам в инете)...
Кинь на форму TColorBox, TOpenDialog, TButton. Обработчик Button'а в коде:

Код

procedure CMYKTORGB(C : byte;
                   M: byte;
                   Y : byte;
                   K : byte;
                   var R : byte;
                   var G : byte;
                   var B : byte);
begin
  if (Integer(C) + Integer(K)) < 255 then
    R := 255 - (C + K) else
    R := 0;
  if (Integer(M) + Integer(K)) < 255 then 
    G := 255 - (M + K) else 
    G := 0; 
  if (Integer(Y) + Integer(K)) < 255 then 
    B := 255 - (Y + K) else 
    B := 0; 
end; // взято из DRKB

procedure TForm1.Button1Click(Sender: TObject);
var
  f : file;
  i, ver, num, len : word;
  col : record
    cspace, w, x, y, z : word;
  end;
  r, g, b : byte;
  clr : TColor;
  clrName : string;
  ws : WideString;

  procedure ReverseWords (var Buf; Size : integer);
  var
    i : integer;
    words : PWordArray;
  begin
    words := @Buf;
    for i := 0 to (Size div 2)-1 do
      words[i] := (Byte(words[i]) shl 8) or (words[i] shr 8);
  end;

  function ReadWord : word;
  begin
    BlockRead (f, Result, SizeOf(Result));
    ReverseWords (Result, SizeOf(Result));
  end;

begin
  if not OpenDialog1.Execute then Exit;

  ColorBox1.Items.Clear;
  AssignFile (f, OpenDialog1.FileName);
  Reset (f, 1);
  ver := ReadWord;
  num := ReadWord;

  for i := 1 to num do
  begin
    BlockRead (f, col, SizeOf(col));
    ReverseWords (col, SizeOf(Col));
    case col.cspace of
      0 :
        begin
          r := col.w div 256;
          g := col.x div 256;
          b := col.y div 256;
        end;
      1 :
        begin
// ... HSB ...
          r := 0; g := 0; b := 0;
        end;
      2 : CMYKTORGB(Trunc(255 - col.w/257),
                    Trunc(255 - col.x/257),
                    Trunc(255 - col.y/257),
                    Trunc(255 - col.z/257),
                    r, g, b);
      7 :
        begin
// ... LAB ...
          r := 0; g := 0; b := 0;
        end;
      8 :
        begin
          r := Trunc(col.w / 39.0625);
          g := r;
          b := r;
        end;
      9 : CMYKTORGB(Trunc(255 - col.w/(10000/255)),
                    Trunc(255 - col.x/(10000/255)),
                    Trunc(255 - col.y/(10000/255)),
                    Trunc(255 - col.z/(10000/255)),
                    r, g, b);
    end;
    clr := RGB(r, g, b);

    clrName := '';
    if ver = 2 then
    begin
      ReadWord;
      len := ReadWord-1;
      SetLength (ws, len);
      if len > 0 then
      begin
        BlockRead (f, ws[1], 2*len);
        ReverseWords (ws[1], 2*len);
        clrName := ws;
      end;
      ReadWord;
    end;
    if clrName = '' then clrName := ColorToString(clr);

    ColorBox1.Items.AddObject(clrName, TObject(clr));
  end;

  CloseFile (f);
end;

--------------------

С уважением, г-н Посол.

SKIF52

Дата 6.7.2005, 23:52 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

большое спасибо... жаль сам не додумался.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »