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

我正在尝试创建一个完全透明的表单,在其上我绘制了一个带有alpha透明度的位图。 问题是我无法弄清楚如何将位图的背景设置为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

谢谢。


您似乎对UpdateLayeredWindow / BLENDFUNCTION工作原理有误解。 使用UpdateLayeredWindow ,您可以使用每像素alpha或一个颜色键。 你用ULW_ALPHA把它称为'dwFlags',这意味着你打算使用每个像素的alpha,并且将一个完全不透明的位图传递给你的预乘法例程(所有像素的alpha值为255)。 您的预乘法程序不会修改Alpha通道,只需根据传递的位图的Alpha通道计算红色绿色和蓝色值。 最后,你得到的是一个完全不透明的位图,具有正确计算的r,g,b(自255/255 = 1以来也是未修改的)。 您将获得的所有透明度都来自您分配给BlendFunction SourceConstantAlpha的'210'。 什么UpdateLayeredWindow给这些是一个半透明的窗口,每个像素具有相同的透明度。

填充位图区域,在问题的注释中提到,似乎可行,因为FillRect调用会覆盖Alpha通道。 alpha值为255的像素现在的alpha值为0. IMO通常应该认为这应该导致未定义的行为,除非您完全理解它是如何/为什么会起作用。

在当前的状态下,这个问题要求使用颜色键而不是每像素阿尔法,或者切割窗体的一个区域( SetWindowRgn )。 如果要使用每个像素的alpha,则它应该以不同方式应用于位图的各个部分。 在对这个问题的评论中,你提到位图将在某个时刻被缩放。 如果使用缩放代码,则还必须确保缩放代码能够保留Alpha通道。

链接地址: http://www.djcxy.com/p/67493.html

上一篇: How do I create a bitmap that has a clear background on a transparent form?

下一篇: How to handle nested structure when traversing with state monad