Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.02.20;
Скачать: CL | DM;

Вниз

Полупрозрачный 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 вся ветка

Текущий архив: 2003.02.20;
Скачать: CL | DM;

Наверх




Память: 0.46 MB
Время: 0.008 c
14-63807
BALU1111
2003-02-03 12:12
2003.02.20
Скорость передачи данных.


3-63587
mate
2003-02-02 12:13
2003.02.20
QReport и Query


6-63721
Usperi
2002-12-31 19:49
2003.02.20
Помогите с HyperTerminal


3-63549
Cossys
2003-02-03 16:23
2003.02.20
Как быстро заполнить поля таблицы


7-63866
Sanyok
2002-12-19 21:10
2003.02.20
Как узнать MAC-адрес сетевой карты?





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