delphi - ¿Cómo creo un mapa de bits que tenga un fondo claro en un formulario transparente?

graphics delphi-xe2

Question

Intento crear un formulario que sea completamente transparente, sobre el cual dibujo un mapa de bits con transparencia alfa. El problema es que no puedo descifrar cómo establecer el fondo del mapa de bits en Alpha 0 (ver por completo).

Así es como se ve el formulario ahora (nota superior derecha no transparente).

Así es como quiero que se vea (arriba a la derecha totalmente transparente):

Aquí está mi fuente:

unit frmMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ActiveX,
GDIPObj, GDIPAPI, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm7 = class(TForm)
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
private
function CreateTranparentForm: TForm;
end;
var
Form7: TForm7;
implementation
{$R *.dfm}
// Thanks to Anders Melander for the transparent form tutorial
// (http://melander.dk/articles/alphasplash2/2/)
function CreateAlphaBlendForm(AOwner: TComponent; Bitmap: TBitmap; Alpha: Byte): TForm;
procedure PremultiplyBitmap(Bitmap: TBitmap);
var
Row, Col: integer;
p: PRGBQuad;
PreMult: array[byte, byte] of byte;
begin
// precalculate all possible values of a*b
for Row := 0 to 255 do
for Col := Row to 255 do
begin
PreMult[Row, Col] := Row*Col div 255;
if (Row <> Col) then
PreMult[Col, Row] := PreMult[Row, Col]; // a*b = b*a
end;
for Row := 0 to Bitmap.Height-1 do
begin
Col := Bitmap.Width;
p := Bitmap.ScanLine[Row];
while (Col > 0) do
begin
p.rgbBlue := PreMult[p.rgbReserved, p.rgbBlue];
p.rgbGreen := PreMult[p.rgbReserved, p.rgbGreen];
p.rgbRed := PreMult[p.rgbReserved, p.rgbRed];
inc(p);
dec(Col);
end;
end;
end;
var
BlendFunction: TBlendFunction;
BitmapPos: TPoint;
BitmapSize: TSize;
exStyle: DWORD;
PNGBitmap: TGPBitmap;
BitmapHandle: HBITMAP;
Stream: TMemoryStream;
StreamAdapter: IStream;
begin
Result := TForm.Create(AOwner);
// Enable window layering
exStyle := GetWindowLongA(Result.Handle, GWL_EXSTYLE);
if (exStyle and WS_EX_LAYERED = 0) then
SetWindowLong(Result.Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);
// Load the PNG from a resource
Stream := TMemoryStream.Create;
try
Bitmap.SaveToStream(Stream);
// Wrap the VCL stream in a COM IStream
StreamAdapter := TStreamAdapter.Create(Stream);
try
// Create and load a GDI+ bitmap from the stream
PNGBitmap := TGPBitmap.Create(StreamAdapter);
try
// Convert the PNG to a 32 bit bitmap
PNGBitmap.GetHBITMAP(MakeColor(0,0,0,0), BitmapHandle);
// Wrap the bitmap in a VCL TBitmap
Bitmap.Handle := BitmapHandle;
finally
FreeAndNil(PNGBitmap);
end;
finally
StreamAdapter := nil;
end;
finally
FreeAndNil(Stream);
end;
// Perform run-time premultiplication
PremultiplyBitmap(Bitmap);
// Resize form to fit bitmap
Result.ClientWidth := Bitmap.Width;
Result.ClientHeight := Bitmap.Height;
// Position bitmap on form
BitmapPos := Point(0, 0);
BitmapSize.cx := Bitmap.Width;
BitmapSize.cy := Bitmap.Height;
// Setup alpha blending parameters
BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := Alpha;
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
UpdateLayeredWindow(Result.Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle,
@BitmapPos, 0, @BlendFunction, ULW_ALPHA);
end;
procedure CopyControlToBitmap(AWinControl: TWinControl; Bitmap: TBitmap; X, Y: Integer);
var
SrcDC: HDC;
begin
SrcDC := GetDC(AWinControl.Handle);
try
BitBlt(Bitmap.Canvas.Handle, X, Y, AWinControl.ClientWidth, AWinControl.ClientHeight, SrcDC, 0, 0, SRCCOPY);
finally
ReleaseDC(AWinControl.Handle, SrcDC);
end;
end;
function MakeGDIPColor(C: TColor; Alpha: Byte): Cardinal;
var
tmpRGB : TColorRef;
begin
tmpRGB := ColorToRGB(C);
result := ((DWORD(GetBValue(tmpRGB)) shl BlueShift) or
(DWORD(GetGValue(tmpRGB)) shl GreenShift) or
(DWORD(GetRValue(tmpRGB)) shl RedShift) or
(DWORD(Alpha) shl AlphaShift));
end;
procedure TForm7.Button2Click(Sender: TObject);
begin
CreateTranparentForm.Show;
end;
function TForm7.CreateTranparentForm: TForm;
const
TabHeight = 50;
TabWidth = 150;
var
DragControl: TWinControl;
DragCanvas: TGPGraphics;
Bitmap: TBitmap;
ControlTop: Integer;
DragBrush: TGPSolidBrush;
begin
DragControl := Panel1;
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit;
Bitmap.Height := TabHeight + DragControl.Height;
Bitmap.Width := DragControl.Width;
ControlTop := TabHeight;
// <<<< I need to clear the bitmap background here!!!
CopyControlToBitmap(DragControl, Bitmap, 0, ControlTop);
DragCanvas := TGPGraphics.Create(Bitmap.Canvas.Handle);
DragBrush := TGPSolidBrush.Create(MakeGDIPColor(clBlue, 255));
try
// Do the painting...
DragCanvas.FillRectangle(DragBrush, 0, 0, TabWidth, TabHeight);
finally
FreeAndNil(DragCanvas);
FreeAndNil(DragBrush);
end;
Result := CreateAlphaBlendForm(Self, Bitmap, 210);
Result.BorderStyle := bsNone;
finally
FreeAndNil(Bitmap);
end;
end;
end.

... y el DFM:

object Form7: TForm7
Left = 0
Top = 0
Caption = ''frmMain''
ClientHeight = 300
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = ''Tahoma''
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 256
Top = 128
Width = 321
Height = 145
Caption = ''Panel1''
TabOrder = 0
object Edit1: TEdit
Left = 40
Top = 24
Width = 121
Height = 21
TabOrder = 0
Text = ''Edit1''
end
object Button1: TButton
Left = 40
Top = 64
Width = 75
Height = 25
Caption = ''Button1''
TabOrder = 1
end
end
object Button2: TButton
Left = 16
Top = 16
Width = 75
Height = 25
Caption = ''Go''
TabOrder = 1
OnClick = Button2Click
end
end

Gracias.

Answer 1

Parece que tiene una idea errónea de cómo funciona UpdateLayeredWindow / BLENDFUNCTION . Con UpdateLayeredWindow , puede usar alfa por píxel o una clave de color. Lo llamas con ULW_ALPHA como ''dwFlags'', lo que significa que tienes la intención de usar alfa por píxel, y pasas un mapa de bits completamente opaco a tu rutina de premultiplicación (todos los píxeles tienen un valor alfa de 255). Su rutina de premultiplicación no modifica el canal alfa, todo lo que hace es calcular los valores rojos, verdes y azules de acuerdo con el canal alfa del mapa de bits pasado. Al final, lo que tienes es un mapa de bits completamente opaco con r, g, b (también sin modificar, 255/255 = 1). Toda la transparencia que obtendrá es del ''210'' que asigna a SourceConstantAlpha of BlendFunction . Lo que UpdateLayeredWindow brinda con estos es una ventana semitransparente, cada píxel tiene la misma transparencia.

Llenar una región del mapa de bits, mencionado en los comentarios a la pregunta, parece funcionar porque la llamada FillRect sobrescribe el canal alfa. Los píxeles que tienen un alfa de 255 ahora tienen un alfa de 0. IMO, normalmente esto se debe considerar que causa un comportamiento indefinido a menos que comprenda completamente cómo y por qué funciona.

La pregunta, en su estado actual, requiere una respuesta de usar una clave de color en lugar de alfa por píxel, o cortar una región de la forma ( SetWindowRgn ). Si se va a usar alfa por píxel, se debe aplicar de manera diferente a las partes del mapa de bits. En los comentarios a la pregunta, menciona que el mapa de bits debe escalarse en algún momento. También debes asegurarte de que el código de escala preserve el canal alfa, si se usa.