Главная страница
    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
1-63679
KonstVD
2003-02-11 17:00
2003.02.20
выход из цикла


1-63638
Sour
2003-02-09 08:04
2003.02.20
Drag&Drop


3-63480
ik
2003-02-04 17:16
2003.02.20
Как нарисовать CheckBox в DBGrid


14-63828
Praco
2003-02-04 15:23
2003.02.20
Документация по компонентам на страничке


3-63546
Pk
2003-02-03 16:34
2003.02.20
Как создать новую таблицу формата dbf или db





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