Алфафина и прозрачная связь
-
13-12-2019 - |
Вопрос
Этот вопрос связан с моим более ранний вопрос на этом.
Я хочу объединить два слоя с альфа, применяемым только к определенной части исходного слоя.Один из способов, которым я пытался, должен был установить SourceconStantalpha до $ FF (и иметь функцию использовать альфа-канал в исходном слое).
Такие виды работы - хотя медленно (я думаю, я могу ускорить его, используя сканиры), та часть того, что я не могу выяснить, что настроить альфа-канал.Документация предполагает, что расчет:
st.Red = Src.Red + (1 - Src.Alpha) * Dst.Red
.
Я попробовал несколько разных ценностей по догадаю работу, но мой первый вопрос: как я вычислять альфа-значение?
После прочтения нескольких других вопросов, я наткнулся на функцию TransparentBLT, которая хорошо замаскирует (и быстро), но не прозрачность, есть ли способ объединить Эти два звонка вместе (возможно, используя третий слой)?
unit MainWnd;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ControlsEx;
type
{------------------------------------------------------------------------------}
TfrmMain = class(TForm)
PaintBox1: TPaintBox;
procedure PaintBox1Paint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
{..............................................................................}
procedure copyToAlpha(const in_bitmap : TBitmap; const in_transparentColor : TColor;
const in_transparency : integer);
var
x : integer;
y : integer;
p : integer;
begin
ASSERT(in_bitmap.PixelFormat = pf32bit);
for x := 0 to in_bitmap.Width - 1 do
begin
for y := 0 to in_bitmap.Height - 1 do
begin
p := in_bitmap.Canvas.Pixels[x, y];
if TColor(p) <> in_transparentColor then
begin
in_bitmap.Canvas.Pixels[x, y] := p or (in_transparency shl 24);
end
else
in_bitmap.Canvas.Pixels[x, y] := p or ($ff shl 24);
end;
end;
end;
{..............................................................................}
procedure alphaBlendTest(
const in_target : TCanvas;
const in_width : integer;
const in_height : integer);
const
BARSIZE = 30;
var
bitmap : TBitmap;
r : TRect;
blendFn : BLENDFUNCTION;
ret : Boolean;
begin
blendFn.BlendOp := AC_SRC_OVER;
blendFn.SourceConstantAlpha := $ff;
blendFn.BlendFlags := 0;
blendFn.alphaFormat := AC_SRC_ALPHA;
bitmap := TBitmap.Create;
try
bitmap.Width := in_width;
bitmap.Height := in_height;
bitmap.PixelFormat := pf32bit;
bitmap.HandleType := bmDIB;
bitmap.TransparentColor := clFuchsia;
bitmap.Transparent := true;
bitmap.Canvas.Brush.Color := clFuchsia;
bitmap.Canvas.FillRect(Bounds(0, 0, in_width, in_height));
bitmap.Canvas.Brush.Color := clGreen;
r := Bounds(
in_width div 2 - (in_width div 3) div 2,
0,
(in_width div 3) + 1,
BARSIZE + 1);
bitmap.Canvas.Rectangle(r);
// done drawing
//copyToAlpha(bitmap, clFuchsia, 1);
ret := Windows.TransparentBlt(
in_target.Handle,
0,
0,
in_width,
in_height,
bitmap.Canvas.Handle,
0,
0,
in_width,
in_height,
clFuchsia);
//blendFn);
ASSERT(ret);
finally
bitmap.Free;
end;
end;
{..............................................................................}
procedure TfrmMain.PaintBox1Paint(Sender: TObject);
var
r: TRect;
begin
PaintBox1.Canvas.Brush.Color := clBlue;
r := Bounds(0, 0, PaintBox1.ClientWidth, PaintBox1.ClientHeight);
PaintBox1.Canvas.FillRect(r);
PaintBox1.Canvas.Brush.Color := clRed;
PaintBox1.Canvas.Ellipse(0, 0, PaintBox1.ClientWidth, PaintBox1.ClientHeight);
alphaBlendTest(PaintBox1.Canvas, PaintBox1.ClientWidth, PaintBox1.ClientHeight);
end;
end.
. Решение
Хитрость: смешивание тех же цветов в любом отношении приводит к тому же цвету.
Итак, самый простой способ (и, возможно, также наиболее эффективный) - сначала нарисовать прозрачный результат к временному растровому ратушению, а алфавита, что растровое изображение на холсте назначения.
с доступом к холсту назначения во время рисования:
procedure TfrmMain.PaintBox1Paint(Sender: TObject);
const
BarSize = 30;
var
R: TRect;
Bmp: TBitmap;
BlendFunc: TBlendFunction;
begin
with PaintBox1 do
begin
R := ClientRect;
Canvas.Brush.Color := clBlue;
Canvas.FillRect(R);
Canvas.Brush.Color := clRed;
Canvas.Ellipse(R);
Bmp := TBitmap.Create;
try
Bmp.Width := Width;
Bmp.Height := Height;
BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0,
SRCCOPY);
Bmp.Canvas.Brush.Color := clGreen;
R := Bounds(Width div 3, 0, Width div 3 + 1, BarSize + 1);
Bmp.Canvas.Rectangle(R);
BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := 80;
BlendFunc.AlphaFormat := 0;
Windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, Bmp.Canvas.Handle,
0, 0, Width, Height, BlendFunc);
finally
Bmp.Free;
end;
end;
end;
.
и без доступа к пунсу назначения во время рисования:
procedure GetRemoteBitmap(Bmp: TBitmap; Width, Height: Integer);
const
BarSize = 30;
var
R: TRect;
begin
Bmp.Canvas.Brush.Color := clFuchsia;
Bmp.Width := Width;
Bmp.Height := Height;
Bmp.TransparentColor := clFuchsia;
Bmp.Transparent := True;
Bmp.Canvas.Brush.Color := clGreen;
R := Bounds(Width div 3, 0, Width div 3 + 1, BarSize + 1);
Bmp.Canvas.Rectangle(R);
end;
procedure TfrmMain.PaintBox1Paint(Sender: TObject);
var
R: TRect;
Bmp: TBitmap;
Tmp: TBitmap;
BlendFunc: TBlendFunction;
begin
with PaintBox1 do
begin
R := ClientRect;
Canvas.Brush.Color := clBlue;
Canvas.FillRect(R);
Canvas.Brush.Color := clRed;
Canvas.Ellipse(R);
Bmp := TBitmap.Create;
Tmp := TBitmap.Create;
try
GetRemoteBitmap(Bmp, Width, Height);
Tmp.Width := Width;
Tmp.Height := Height;
BitBlt(Tmp.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0,
SRCCOPY);
TransparentBlt(Tmp.Canvas.Handle, 0, 0, Width, Height, Bmp.Canvas.Handle,
0, 0, Width, Height, ColorToRGB(clFuchsia));
BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := 80;
BlendFunc.AlphaFormat := 0;
Windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, Tmp.Canvas.Handle,
0, 0, Width, Height, BlendFunc);
finally
Tmp.Free;
Bmp.Free;
end;
end;
end;
. Другие советы
Просто ради полноты ( "Как вы рассчитывать альфа-значение?" ):
procedure alphaBlendTest(
const in_target : TCanvas;
const in_width : integer;
const in_height : integer);
const
BARSIZE = 30;
var
bitmap : TBitmap;
r : TRect;
blendFn : BLENDFUNCTION;
ret : Boolean;
x, y: Integer;
px : PRGBQuad;
begin
blendFn.BlendOp := AC_SRC_OVER;
blendFn.SourceConstantAlpha := $ff;
blendFn.BlendFlags := 0;
blendFn.alphaFormat := AC_SRC_ALPHA;
bitmap := TBitmap.Create;
try
bitmap.Width := in_width;
bitmap.Height := in_height;
bitmap.PixelFormat := pf32bit;
bitmap.Canvas.Brush.Color := clGreen;
r := Bounds(
in_width div 2 - (in_width div 3) div 2,
0,
(in_width div 3) + 1,
BARSIZE + 1);
bitmap.Canvas.Rectangle(r);
for y := 0 to bitmap.Height - 1 do begin
px := bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do begin
if PtInRect(r, Point(x, y)) then begin
px.rgbBlue := MulDiv(px.rgbBlue, $A0, $FF);
px.rgbGreen := MulDiv(px.rgbGreen, $A0, $FF);
px.rgbRed := MulDiv(px.rgbRed, $A0, $FF);
px.rgbReserved := $A0;
end else
px.rgbReserved := $00; // fully transparent
Inc(px);
end;
end;
// done drawing
ret := Windows.AlphaBlend(
in_target.Handle,
0,
0,
in_width,
in_height,
bitmap.Canvas.Handle,
0,
0,
in_width,
in_height,
blendFn);
ASSERT(ret);
finally
bitmap.Free;
end;
end;
.