如何在透明表單上創建背景清晰的位圖？

Question

我想創建一個完全透明的窗體，在其上繪製一個帶有透明度的位圖。問題是我無法弄清楚如何將位圖的背景設置爲Alpha 0（完全透視）。

下面是表單現在的樣子（注意右上角不透明）。

以下是我希望它看起來（右上完全透明）：

這裏是我的源：

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. 

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

謝謝。

Answer 1

您似乎對UpdateLayeredWindow/BLENDFUNCTION的工作原理有誤解。使用UpdateLayeredWindow，您可以使用每像素alpha或一個顏色鍵。你用作爲'dwFlags'來調用它，這意味着你打算使用每像素alpha，並且將完全不透明的位圖傳遞到預乘複製例程（所有像素的alpha值爲255）。您的預乘法程序不會修改Alpha通道，只需根據傳遞的位圖的Alpha通道計算紅色綠色和藍色值。最後，你得到的是一個完全不透明的位圖，具有正確計算的r，g，b（自255/255 = 1以來也是未修改的）。您將獲得的所有透明度都來自您分配給SourceConstantAlpha的BlendFunction的'210'。 UpdateLayeredWindow給出的是一個半透明窗口，每個像素具有相同的透明度。

填充位圖區域，在問題的評論中提到，似乎工作，因爲FillRect調用覆蓋alpha通道。 alpha值爲255的像素現在的alpha值爲0. IMO通常應該認爲這應該導致未定義的行爲，除非您完全理解它是如何/爲什麼會起作用。

在當前狀態下，問題需要使用顏色鍵而不是每像素阿爾法，或者切割窗體區域（SetWindowRgn）。如果要使用每個像素的alpha，則它應該以不同方式應用於位圖的各個部分。在對這個問題的評論中，你提到位圖將在某個時刻被縮放。如果使用縮放代碼，則還必須確保縮放代碼能夠保留Alpha通道。