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.