Отрисовка картинки Png c прозрачностью+текста

[Лекс Айрин]

RedCat, а вот у меня в проге обратная ситуация. Хочу сохранить фон окна, а он сохраняется вместе со всеми компонентами.

[olegy123]

tBitmap

классический виндовый (95~XP) TBitmap не знает о прозрачности.
как сейчас не вкурсе..

[Лекс Айрин]

olegy123, сам да, а вот поддерживающие его компоненты вполне. Если что, то я сижу на ХР.

[Alex2013]

Чисто как вариант решения... (там сугубо под 24-бита но для задачи нарисовать текст поверх картинки это фиолетово )

(Нигде не оптимально но работает )

Код: Выделить всё

// Прозрачность + прозрачный цвет
{Src1,Src2,Dst - понятно
CT -прозрачный цвет
Amount - 0.001-1.0 - реальное смешение  }

procedure Blend2(Const Src1,Src2,Dst: TBitmap; CT: Integer;Amount: extended);
var w,h,x,y:integer;
    ps1,ps2,pd:pbytearray;
begin
w:=Src1.Width;
h:=Src1.Height;
//Dst.Width:=w;
//Dst.Height:=h;
//Src1.PixelFormat:=pf24bit;
//Src2.PixelFormat:=pf24bit;
//Dst.PixelFormat:=pf24bit;
for y:=0 to h-1 do begin
ps1:=Src1.ScanLine[y];
ps2:=Src2.ScanLine[y];
Dst.BeginUpdate; ;
pd:=Dst.ScanLine[y];
for x:=0 to w-1 do
If RGB(ps2[x*3+2],ps2[x*3+1],ps2[x*3])<>CT then
begin
If Amount<>1 then begin
  pd[x*3]  :=round((1-Amount)*ps1[x*3]+Amount*ps2[x*3]);
  pd[x*3+1]:=round((1-Amount)*ps1[x*3+1]+Amount*ps2[x*3+1]);
  pd[x*3+2]:=round((1-Amount)*ps1[x*3+2]+Amount*ps2[x*3+2]);
  end else Move(ps2[x*3], pd[x*3],3);
  end else Move(ps1[x*3], pd[x*3],3);
Dst.EndUpdate;
end;
end;



[RedCat]

Alex2013 спасибо, но кажется что Лазарь рисует текст с антиалиасингом, т.е. по цвету прозрачность не удается сделать

[Лекс Айрин]

RedCat, мне удавалось загрузить и положить фоном на окно даже полупрозрачный png. Точнее даже с переходом прозрачности. Это позволяет надеяться на полноценный альфа-канал. Другое дело, что при загрузке вполне могут и свести изображение в процессе наложения.
Если речь о сглаживании шрифтов, то это скорее от системы зависит, а не от лазаруса.

[RedCat]

Посмотрю на досуге, сейчас на работе, не много не хватает времени заняться, впринципе информация есть теперь нужно подумать как все это реализовать, идея такая, использовать в буфере вместо tbitmap TLazIntfImage и рисовать все на нем, а потом переносить его уже на канву своего компонента, я так думаю что это должно сработать

[Alex2013]

Alex2013 спасибо, но кажется что Лазарь рисует текст с антиалиасингом, т.е. по цвету прозрачность не удается сделать

Так там просто очередность соблюдать нужно "рисуешь" допустим "белый" (хоть с двумя антиалиасингами ) текст (с "черным фоном" ) на черном битмапе . И накладываешь его на свою картинку ("Прозрачный цвет" черный ... ) И как-бы там и лазарус и вида не изощрялись тебе "по барабану".

Добавлено спустя 1 час 49 секунд:
Вот так работает ! Причина появления "цветных букв" не в антиалиасинге,а в не совпадение формата (нужно сконвертировать битмап pf32bit в pf24bit что в LCL делается через Canvas.Draw )
(в Image1 заранее загружена 32 бита картинка )

Код: Выделить всё

procedure TForm1.FormCreate(Sender: TObject);
Var B,B1:TBitmap;
begin

B:=TBitmap.Create; b.PixelFormat:=pf24bit;
B1:=TBitmap.Create;b1.PixelFormat:=pf24bit;
B1.SetSize(Image1.Width,Image1.Height);
b1.Canvas.Draw(0,0,Image1.Picture.Bitmap); //Draw Конвертирует цвета pf32bit -> pf24bit;

b.Canvas.Brush.Color:=clBlack; B.SetSize(Image1.Width,Image1.Height);
// при  SetSize автоматом закрашивает черным.

B.Canvas.Font.Color:=ClWhite;
B.Canvas.TextOut(10,10,'Привет аборигенам...' );

Blend2(b1,b,B1,clBlack,1);

Image1.Picture.Bitmap.Assign(B1);
b.free; b1.free;
end;


Хотя если бы у меня стояла бы задача просто написать текст поверх картинки я бы сделал проще. (Зато таким образом можно накладывать не только текст + есть реальная полупрозрачность если в Blend2 Amount поставить меньше единцы. )