Jak utworzyć mapę bitową z przezroczystym tłem w przejrzystym formularzu?

Question

Próbuję utworzyć formularz, który jest całkowicie przezroczysty, a na nim rysuję mapę bitową z przezroczystością alfa. Problem polega na tym, że nie mogę wymyślić, jak ustawić tło mapy bitowej na Alfa 0 (całkowicie przejrzeć).

Oto, jak wygląda teraz formularz (uwaga w prawym górnym rogu nie jest przezroczysty).

Oto jak chcę to patrzeć (górny prawy całkowicie przezroczysty):

Oto moje źródło:

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. 

... i 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 

Dzięki.

Answer 1

Wydaje się, że błędnie rozumiesz, jak działa UpdateLayeredWindow/BLENDFUNCTION. W przypadku UpdateLayeredWindow używasz alfa w pikselach lub klucza koloru. Nazywasz to jako "dwFlags", co oznacza, że ​​zamierzasz używać alfa w pikselach, i przekazujesz całkowicie nieprzezroczystą mapę bitową do procedury wstępnego powiększania (wszystkie piksele mają wartość alfa 255). Twoja procedura wstępnego powiększania nie modyfikuje kanału alfa, wszystko, co robi, to obliczanie czerwonych zielonych i niebieskich wartości zgodnie z kanałem alfa przekazanej bitmapy. Ostatecznie masz w pełni nieprzezroczystą bitmapę z poprawnie obliczonymi r, g, b (również niezmodyfikowanymi, od 255/255 = 1). Cała przezroczystość, jaką otrzymasz, pochodzi z "210" przypisanego do SourceConstantAlpha z BlendFunction. To, co daje UpdateLayeredWindow, to półprzezroczyste okno, z którego każdy piksel ma taką samą przezroczystość.

Wypełnienie regionu mapy bitowej, o którym mowa w komentarzach do pytania, wydaje się działać, ponieważ wywołanie FillRect nadpisuje kanał alfa. Piksele o liczbie a wynoszącej 255 mają teraz wartość alfa równą 0. IMO, zazwyczaj należy uznać, że powoduje niezdefiniowane zachowanie, chyba że w pełni zrozumiesz, jak/dlaczego to działa.

Pytanie w swoim obecnym stanie wymaga odpowiedzi przy użyciu klucza koloru zamiast piksela alfa lub wycięcia regionu formularza (SetWindowRgn). Jeśli ma być stosowany piksel alfa, należy go zastosować w różny sposób do części bitmapy. W komentarzach do pytania wspominasz, że bitmapa ma zostać skalowana w pewnym momencie. Musisz również upewnić się, że kod skalujący zachowuje kanał alfa, jeśli jest używany.