Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2004.10.03;
Скачать: [xml.tar.bz2];

Вниз

Как Разбить иконку на каналы (выделить Альфа-канал)   Найти похожие ветки 

 
Tahion2   (2004-07-03 17:47) [0]

У каждой иконки XP стиля есть Альфа-канал. Он отвечает за прозрачность иконки и тени.

Как отделить этот канал от RGB канала (-ов), выполнить над каждым из нрих свои действия, а потом склеить назад в одно целое?

См. Иллюстрацию к вопросу:
http://www.Rudnik.com.ua/XpIcon.jpg


 
Огромное Кулясищще ©   (2004-07-03 18:45) [1]

См. TIcon32.


 
Tahion2   (2004-07-03 19:47) [2]

А можно подробнее? А то что-то посмотрел и ничего интересного для моей проблемы не увидел.


 
Огромное Кулясищще ©   (2004-07-03 20:12) [3]

if FBlendMode = bmColor then
col := BlendColors ( FBGColor, RGB( FData^, FData^[i+1], FData^[i]), FData^[i+3] / 256)

Что ещё надо?


 
Огромное Кулясищще ©   (2004-07-03 20:13) [4]

Т.к. Delphi не поддерживает настоящее рисование pf32bit, то автор не видит смысла хранить иконку в этом формате.


 
Tahion2   (2004-07-04 11:06) [5]

Огромное Кулясищще, можно еще подробнее. Хоть пару комментатиев к приведенному куску кода?

А вообще опишу свою проблему подробнее:
Мне нужно сделать функцию Colorize для иконок. Т.е. отображение иконки в оттенках определенного цвета.
Такую функцию я нашел, но она предназначена для колоризации TBitmap. Я хочу доработать ее, чтоб она работала с иконкаками.

Для этого, думаю, отделить у иконки альфа канал, колоризировать RGB канал и потом наложить его назад на альфа канал.
Собственно, как это сделать?

Код процедуры колоризации:
procedure ModColors(Bitmap: TBitmap; Color: TColor);
 function GetR(const Color: TColor): Byte;
   //извлечение красного
 begin
   Result := Lo(Color);
 end;
 function GetG(const Color: TColor): Byte;
   //извлечение зелёного
 begin
   Result := Lo(Color shr 8);
 end;
 function GetB(const Color: TColor): Byte;
   //извлечение синего
 begin
   Result := Lo((Color shr 8) shr 8);
 end;

 function BLimit(B: Integer): Byte;
 begin
   if B < 0 then
     Result := 0
   else if B > 255 then
     Result := 255
   else
     Result := B;
 end;

type
 TRGB = record
   B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 r1, g1, b1: Byte;
 x, y: Integer;
 Dest: pRGB;
 A: Double;
begin
 Bitmap.PixelFormat := pf24Bit;
 r1 := Round(255 / 100 * GetR(Color));
 g1 := Round(255 / 100 * GetG(Color));
 b1 := Round(255 / 100 * GetB(Color));
 for y := 0 to Bitmap.Height - 1 do
 begin
   Dest := Bitmap.ScanLine[y];
   for x := 0 to Bitmap.Width - 1 do
   begin
     with Dest^ do
     begin
       A := (r + b + g) / 300;
       with Dest^ do
       begin
         R := BLimit(Round(r1 * A));
         G := BLimit(Round(g1 * A));
         B := BLimit(Round(b1 * A));
       end;
     end;
     Inc(Dest);
   end;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var Bitmap:TBitmap;
begin
Bitmap:=TBitmap.Create;
Bitmap.LoadFromFile("D:\2.bmp");
Image1.Picture.Bitmap:=Bitmap;
if ColorDialog1.Execute then
    ModColors(Bitmap, ColorDialog1.Color);
Image2.Picture.Bitmap:=Bitmap;

Bitmap.SaveToFile("D:\2.bmp");
end;


 
Tahion2   (2004-07-04 14:53) [6]

еще варианты будут?


 
Огромное Кулясищще ©   (2004-07-04 17:18) [7]

Вот эта штука, которая грузит иконку:

if FBlendMode = bmColor then
col := BlendColors ( FBGColor, RGB( FData^, FData^[i+1], FData^[i]), FData^[i+3] / 256)

FBGColor - это цвет фона. Можешь сделать белым.
FData^, FData^[i+1], FData^[i] - вот составляющие 24-бит, их пишешь в TBitmap. Только тут они расположены ввиде RGB, а TColor имеет структуру BGR.
FData^[i+3] - альфа-составляющая. Чёрный - прозрачное, белый - непрозрачное. Можешь писать их в отдельное изображение.

Сохранение обратно загрузке.


 
Tahion2   (2004-07-04 18:31) [8]

DataSize:=FData^[14]+(FData^[15] shl 8)+(FData^[16] shl 16)+(FData^[17] shl 24);
bw:=FData^[26] + (FData^[27] shl 8) + (FData^[28] shl 16) + (FData^[29] shl 24);
bs:=FData^[42] + (FData^[43] shl 8) + (FData^[44] shl 16) + (FData^[45] shl 24);


Кулясищще? подскажи, что хранится в переменных DataSize ,bw и bs?

x := 0; y := bw-1;
        i := 62;
        while i < bs + 62 do
        begin
           col := RGB(FData^[i+2],FData^[i+1],FData^[i]);

           if BPP = 32 then
..............


И почему в данном куске кода выбрано именно число 62? Что оно значит?


 
Огромное Кулясищще ©   (2004-07-04 19:52) [9]

Что такое bw?


  case bw of
     16 : IconSize := is16;
     24 : IconSize := is24;
     32 : IconSize := is32;
     48 : IconSize := is48;
  end; // Case


Думаю, понятно. Остальное - чёрт его знает.

Если всё же интересно, то вот структура (внизу самом):

http://kainsk.tomsk.ru/g2003/sys26/oswin.htm

Далее, непонятно, что тебе мешает... щас, в следующем посте напишу.


 
Огромное Кулясищще ©   (2004-07-04 20:02) [10]

Так вот, LoadBMP модернизировать легко:



// Созданы, готовы, к употреблению
var Bmp24bit, BmpAlpha: TBitmap;

procedure LoadBMP;
var
   // лишнее удалить
   i, x, y, DataSize, bw, bs : Integer;
   BPP : Byte;
   col : TColor;
   bmp2 : TBitmap;
   dc : HDC;
   cp : TPoint;
begin
  if FDataSize < 1 then
     Exit; // не мешаем

  BPP := FData^[12];

  if BPP <> 32 then
  begin
     MessageDlg("Invalid icon",mtError,[mbOk],0);
     FIcon32Name := "";

     if not Empty then
        FreeMem(FData, FDataSize);

     FDataSize := 0;
     Exit;
  end;

  DataSize := FData^[14] + (FData^[15] shl 8) + (FData^[16] shl 16) + (FData^[17] shl 24);
  bw       := FData^[26] + (FData^[27] shl 8) + (FData^[28] shl 16) + (FData^[29] shl 24);
  bs       := FData^[42] + (FData^[43] shl 8) + (FData^[44] shl 16) + (FData^[45] shl 24);

  case bw of
     16 : IconSize := is16;
     24 : IconSize := is24;
     32 : IconSize := is32;
     48 : IconSize := is48;
  end; // Case

  if bs < 100 then
     bs := DataSize - 104;

  Bmp24bit.Width := FData^[6];
  Bmp24bit.Height := FData^[6];
  Bmp24bit.Canvas.Brush.Color := clWhite;
  Bmp24bit.Canvas.FillRect(Rect(0, 0, Bmp24bit.Width-1, Bmp24bit.Height-1));

  try
     BmpAlpha.Width := Bmp24bit.Width;
     BmpAlpha.height := Bmp24bit.Height;

     try
        x := 0; y := bw-1;
        i := 62;
        while i < bs + 62 do
        begin
           col := RGB(FData^[i+2],FData^[i+1],FData^[i]);
           Bmp24bit.Canvas.Pixels[x, y] := col;

           if BPP = 32 then
           begin
              if FBlendMode = bmColor then
                 col := RGB(FData^[i+3], FData^[i+3], FData^[i+3]);
               BmpAlpha.Canvas.Pixels[x, y] := col;

                     end;

           Inc(i, BPP div 8);
           Inc(x);
           if x > bw-1 then
           begin
              x := 0;
              Dec(y);
           end;
           if y = -1 then
              break;
        end;
     finally

     end;
  finally

  end;

end;


Не тестил, но суть должна быть ясна.


 
Tahion2   (2004-07-10 09:00) [11]

Вот блин, у Icon32 существенное ограничение:
Он НЕ глючит только если иконка содержит один фрмат внутри. Если же в ней несколько форматов (48*48, 32*32б а то еще и 64*64) то Icon32 начинает говорить "Ошибка доступа по адресу...." или "Invalid icon"

Мне нужно иметь доступ к каждому пикселю КАЖДОГО формата, содержащегося в иконке. Кто что может порекомендовать?


 
Tahion2   (2004-07-12 13:53) [12]

Есть варианты, кроме чем как "ручками писать" ?


 
Огромное Кулясищще ©   (2004-07-12 17:25) [13]

В другой ветке предлагаемые решения.



Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2004.10.03;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.49 MB
Время: 0.043 c
14-1095339796
Soft
2004-09-16 17:03
2004.10.03
Suicide.


1-1095196082
kle[z]a
2004-09-15 01:08
2004.10.03
нестандартные формы


8-1089184267
Ale}{(is)
2004-07-07 11:11
2004.10.03
Алгоритм «интеллектуального» обеднения палитры


4-1093000285
kukuikar
2004-08-20 15:11
2004.10.03
Как убрать или спрятать кнопку на InputBox?


14-1094846616
тихий вовочка
2004-09-11 00:03
2004.10.03
Русификация программ





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский