Главная страница
    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.006 c
3-63526
Толян
2003-02-03 11:40
2003.02.20
QReport, размещение.


4-63892
Аноним
2003-01-09 14:29
2003.02.20
Плиз подскаажите как получить хындл Десктопа?


4-63906
Scorp
2003-01-08 21:53
2003.02.20
Програмное выполнение команды через командную строку


14-63781
Tldrmyh
2003-02-03 04:28
2003.02.20
www.delphikingdom.com


14-63830
Зорро
2003-02-04 17:03
2003.02.20
Интернет технологии





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