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

Вниз

Полупрозрачный Bitmap поверх картинки В Image   Найти похожие ветки 

 
Alex   (2002-11-04 19:55) [0]

Всем привет!
Проблема в сущности небольшая но я уже запутался.
на форме есть Image (300х300), в нем картинка,
Есть две bmp 15х15, их нужно вывести на image1, с использованием ключевого цвета.
Делал так:
Загружал битмапы в ImageList устанавливал ключевой цвет, и копировал в image
от туда копировал на главный image
bitblt (form1.image1.Picture.Bitmap.Canvas.Handle ,
(a-1)*15,(b-1)*15,15,15,form1.image3.Picture.Bitmap.Canvas.Handle ,0,0, SRCCOPY);
пробовал вот так:
{Данная процедура рисует исходное изображение на целевом,
получая информацию об областях исходного изображения,
которые должны остаться в области целевого изображения, имеющей прозрачный цвет.
t = Целевой холст для рисования
x,y = Позиция целевого изображения, где должно быть наложено исходноеs = Исходное изображение
TrCol = Цвет, определяющий прозрачность в исходном изображении
Примечание: Не забывайте обновлять (repaint) целевое изображение, например так: Image1.Invalidate}
procedure DrawTransparent(t: TCanvas; x,y: Integer; s: TBitmap; TrCol: TColor);
var
bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
oldcol: Longint;
begin
try
bmpAND := TBitmap.Create; bmpAND.Width := s.Width; bmpAND.Height := s.Height; bmpAND.Monochrome := True;
oldcol := SetBkColor(s.Canvas.Handle, ColorToRGB(TrCol));
BitBlt(bmpAND.Canvas.Handle, 0,0,s.Width,s.Height, s.Canvas.Handle, 0,0, SRCCOPY);
SetBkColor(s.Canvas.Handle, oldcol);
bmpINVAND := TBitmap.Create; bmpINVAND.Width := s.Width; bmpINVAND.Height := s.Height; bmpINVAND.Monochrome := True;
BitBlt(bmpINVAND.Canvas.Handle, 0,0,s.Width,s.Height, bmpAND.Canvas.Handle, 0,0, NOTSRCCOPY);
bmpXOR := TBitmap.Create; bmpXOR.Width := s.Width; bmpXOR.Height := s.Height;
BitBlt(bmpXOR.Canvas.Handle, 0,0,s.Width,s.Height, s.Canvas.Handle, 0,0, SRCCOPY);
BitBlt(bmpXOR.Canvas.Handle, 0,0,s.Width,s.Height, bmpINVAND.Canvas.Handle, 0,0, SRCAND);
bmpTarget := TBitmap.Create; bmpTarget.Width := s.Width; bmpTarget.Height := s.Height;
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, t.Handle, x,y, SRCCOPY);
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, bmpAND.Canvas.Handle, 0,0, SRCAND);
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, bmpXOR.Canvas.Handle, 0,0, SRCINVERT);
BitBlt(t.Handle, x,y,s.Width,s.Height, bmpTarget.Canvas.Handle, 0,0, SRCCOPY);
finally
bmpXOR.Free; bmpAND.Free; bmpINVAND.Free; bmpTarget.Free;
end;{Конец секции TRY}
end;
Буду{Данная процедура рисует исходное изображение на целевом,

получая информацию об областях исходного изображения,
которые должны остаться в области целевого изображения, имеющей прозрачный цвет.
t = Целевой холст для рисования
x,y = Позиция целевого изображения, где должно быть наложено исходноеs = Исходное изображение
TrCol = Цвет, определяющий прозрачность в исходном изображении
Примечание: Не забывайте обновлять (repaint) целевое изображение, например так: Image1.Invalidate}

procedure DrawTransparent(t: TCanvas; x,y: Integer; s: TBitmap; TrCol: TColor);
var
bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
oldcol: Longint;
begin

try
bmpAND := TBitmap.Create; bmpAND.Width := s.Width; bmpAND.Height := s.Height; bmpAND.Monochrome := True;
oldcol := SetBkColor(s.Canvas.Handle, ColorToRGB(TrCol));
BitBlt(bmpAND.Canvas.Handle, 0,0,s.Width,s.Height, s.Canvas.Handle, 0,0, SRCCOPY);
SetBkColor(s.Canvas.Handle, oldcol);


bmpINVAND := TBitmap.Create; bmpINVAND.Width := s.Width; bmpINVAND.Height := s.Height; bmpINVAND.Monochrome := True;
BitBlt(bmpINVAND.Canvas.Handle, 0,0,s.Width,s.Height, bmpAND.Canvas.Handle, 0,0, NOTSRCCOPY);


bmpXOR := TBitmap.Create; bmpXOR.Width := s.Width; bmpXOR.Height := s.Height;
BitBlt(bmpXOR.Canvas.Handle, 0,0,s.Width,s.Height, s.Canvas.Handle, 0,0, SRCCOPY);
BitBlt(bmpXOR.Canvas.Handle, 0,0,s.Width,s.Height, bmpINVAND.Canvas.Handle, 0,0, SRCAND);

bmpTarget := TBitmap.Create; bmpTarget.Width := s.Width; bmpTarget.Height := s.Height;
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, t.Handle, x,y, SRCCOPY);
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, bmpAND.Canvas.Handle, 0,0, SRCAND);
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, bmpXOR.Canvas.Handle, 0,0, SRCINVERT);
BitBlt(t.Handle, x,y,s.Width,s.Height, bmpTarget.Canvas.Handle, 0,0, SRCCOPY);
finally
bmpXOR.Free;
bmpAND.Free;
bmpINVAND.Free;
bmpTarget.Free;
end;{Конец секции TRY}
end;
картинка при последнем способе искажается.
Сорри за излишнее цитирование, пример привел чтоб не повторятся.


 
Пьера Тортерю   (2002-11-04 21:23) [1]

не очень понял но ведь у имаджлиста есть своя процедура Draw которая рисует куда ты хочешь!!!


 
Ich Hasse   (2002-11-04 21:44) [2]

зачем у BitMap"a есть свои свойства transparent, ну а уж если хочешь через API то великолепная функция TransparentBLT, но есть только в Delphi 6 и выше


 
Alex   (2002-11-05 16:55) [3]

Спасибо за ответы , вроде розобрался.



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

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

Наверх




Память: 0.46 MB
Время: 0.007 c
6-63706
Makep
2002-12-30 02:41
2003.02.20
ЧАТ!!! (для лок. сетевой)


1-63679
KonstVD
2003-02-11 17:00
2003.02.20
выход из цикла


3-63552
mate
2003-02-03 16:59
2003.02.20
Динамический отчёт


14-63804
LordMax
2003-02-04 00:18
2003.02.20
Копирование


3-63535
Sergeyy
2003-02-03 14:11
2003.02.20
Фильтрация по lookup ам





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский