Question

我正在尝试创建一个完全透明的表单，我在其上绘制具有Alpha透明度的位图。问题是我无法弄清楚如何将位图的背景设置为Alpha 0（完全透视）。

以下是表单现在的样子（注意右上角不透明）。

enter image description here

这就是我想要的样子（右上角完全透明）：

enter image description here

这是我的来源：

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或颜色键。您将ULW_ALPHA称为'dwFlags'，这意味着您打算使用每像素alpha，并将完全不透明的位图传递给预乘程序（所有像素的alpha值都为255）。您的预乘程序不会修改Alpha通道，它只是根据传递的位图的Alpha通道计算红绿色和蓝色值。最后，你得到的是一个完全不透明的位图，正确计算r，g，b（也是未修改的，因为255/255 = 1）。您将获得的所有透明度均来自您分配给SourceConstantAlpha BlendFunction的'{1}}。 UpdateLayeredWindow给出的是半透明窗口，每个像素具有相同的透明度。

填写问题评论中提到的位图区域似乎有效，因为FillRect调用会覆盖alpha通道。 alpha为255的像素现在的alpha值为0. IMO，通常这应该被视为导致未定义的行为，除非你完全理解它是如何/为什么有效。

在当前状态下，问题需要使用颜色键而不是每像素alpha，或者切割表单区域（SetWindowRgn）的答案。如果要使用每像素alpha，则应以不同方式应用于位图的某些部分。在对问题的评论中，您提到位图将在某个时刻进行缩放。您还必须确保缩放代码保留alpha通道（如果已使用）。

如何在透明表单上创建具有清晰背景的位图？

1 个答案: