在Delphi中以alpha混合PNG形式淡入 几年前，当我第一次发布Vista的时候，我问了一个关于这个问题，但是从来没有解决这个问题，把它搁置起来作为以后要考虑的事情。p>

我有一个闪屏，我花了很大的努力使它看起来很棒。这是一个32bpp的alpha混合PNG。我有一些代码（如果需要，我可以挖掘！），在Windows XP或Vista+下，当桌面合成关闭时，这些代码非常有效。然而，在Vista+下，所有的透明部分都是黑色的，破坏了它所有看起来很棒的东西

所以，我的问题是：任何人都能够将32bpp的alpha混合PNG显示为启动屏幕，无论是否激活桌面合成，都可以？我不反对使用第三方组件，如果需要，免费或其他

理想情况下，这将在Delphi7中工作

---

更新：除了下面的答案外，我发现TMS TAdvSmoothSplashScreen组件也能很好地处理这项任务，尽管有点复杂。

Tim，我刚刚在Vista/D2007上选择了“Windows Classic”主题进行了尝试：

Delphi中的Alpha混合启动屏幕-第2部分

---

没有我能看到的黑色背景。。。它看起来仍然很棒。

Bob链接到的文章给出了正确答案。由于那篇文章包含了您实际需要的相当多的额外信息，下面是我通过它创建的表单/单元（请注意，您需要GraphicEx库：

unitsplash2form；
接口
使用
窗口、消息、系统工具、变体、类、图形、控件、窗体、，
对话框、ExtCtrls、GraphicEx；
类型
TSplash2=等级（TForm）
私有的
{私有声明}
过程预乘法位图（位图：TBitmap）；
公众的
构造函数创建（所有者：TComponent）；重写；
{公开声明}
过程CreateParams（变量参数：TCreateParams）；重写；
程序执行；
结束；
变量
Splash2:TSplash2；
实施
{$R*.dfm}
{TSplash2}
构造函数TSplash2.Create（所有者：TComponent）；
开始
继承；
画笔样式：=b画笔；
结束；
程序TSplash2.CreateParams（变量参数：TCreateParams）；
开始
继承；
结束；
程序TSplash2.Execute；
var-exStyle:DWORD；
BitmapPos:TPoint；
位图大小：TSize；
BlendFunction:TBlendFunction；
PNG:TPNGGraphic；
Stream:TResourceStream；
开始
//启用窗口分层
exStyle:=GetWindowLongA（句柄，GWL_exStyle）；
如果（exStyle和WS_EX_LAYERED=0），则
SetWindowLong（句柄、GWL_EXSTYLE、EXSTYLE或WS_EX_分层）；
PNG:=TPNGGraphic.Create；
尝试
Stream:=TResourceStream.Create（HInstance，'SPLASH'，RT\u RCDATA）；
尝试
PNG.LoadFromStream（Stream）；
最后
免费；
结束；
PreMultiplyBitmap（PNG）；
ClientWidth:=PNG.Width；
ClientHeight:=巴布亚新几内亚高度；
BitmapPos:=点（0,0）；
BitmapSize.cx:=客户端宽度；
BitmapSize.cy:=ClientHeight；
//设置alpha混合参数
BlendFunction.BlendOp:=AC_SRC_OVER；
BlendFunction.BlendFlags:=0；
BlendFunction.SourceConstantAlpha:=255；
BlendFunction.AlphaFormat:=AC_SRC_ALPHA；
//…还有行动！
UpdateLayeredWindow（句柄，0，nil，@BitmapSize，PNG.Canvas.Handle，
@BitmapPos，0，@BlendFunction，ULW_ALPHA）；
显示
最后
巴布亚新几内亚免费；
结束；
结束；
程序TSplash2.PreMultiplyBitmap（位图：TBitmap）；
变量
行，列：整数；
p:PRGBQuad；
PreMult：字节的数组[字节，字节]；
开始
//预先计算a*b的所有可能值
对于行：=0到255 do
对于列：=行到255 do
开始
前置结果[行，列]：=行*列div 255；
如果（行列）那么
PreMult[Col，Row]：=PreMult[Row，Col]；//a*b=b*a
结束；
对于行：=0到位图.Height-1 do
开始
Col:=位图。宽度；
p:=位图.扫描线[行]；
而（Col>0）做什么
开始
p、 rgbBlue:=预结果[p.rgb，p.rgbBlue]；
p、 rgbGreen:=PreMult[p.rgbReserved，p.rgbGreen]；
p、 rgbreed:=PreMult[p.rgbreed，p.rgbreed]；
公司(p),；
dec（Col）；
结束；
结束；
结束；
结束。

+1.我最近关注了那篇文章（第1部分和第2部分），可以确认它在Vista Aero.Hrm上运行。对我来说，它似乎几乎在Aero下运行。由于未知原因，出现了窗口边框。在Delphi 7下编译；其他人也会这样吗？是的，甚至在Aero上看起来更好…：）你的驱动程序是最新的吗，尽可能最新！要明确的是，它不是一个黑色边框，它就像一个普通的表单，带有最小化、最大化和关闭按钮、标题栏等等。根据下面的评论，将BorderStyle设置为bsNone修复了视觉问题！谢谢同样，我也遇到了与上面相同的问题：在Vista Aero中，它周围有一个窗口边框。在Delphi7中编译。想法？您是否将TSplash2.BorderStyle设置为bsNone？这将完全删除窗口边框。请尝试将边框样式更改为bsNone。如果这不起作用，我以后在我的工作机器上再看一眼。更改边框样式修复了它！谢谢

unit Splash2Form;

interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ExtCtrls, GraphicEx;

type
    TSplash2 = class(TForm)
    private
        { Private declarations }
    procedure PreMultiplyBitmap(Bitmap: TBitmap);
    public
        constructor Create(Owner: TComponent);override;
        { Public declarations }
        procedure CreateParams(var Params: TCreateParams);override;
    procedure Execute;
  end;

var
  Splash2: TSplash2;

implementation

{$R *.dfm}

{ TSplash2 }

constructor TSplash2.Create(Owner: TComponent);
begin
  inherited;
  Brush.Style := bsClear;
end;

procedure TSplash2.CreateParams(var Params: TCreateParams);
begin
    inherited;
end;

procedure TSplash2.Execute;
var exStyle: DWORD;
    BitmapPos: TPoint;
  BitmapSize: TSize;
  BlendFunction: TBlendFunction;
  PNG: TPNGGraphic;
  Stream: TResourceStream;
begin
  // Enable window layering
  exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
  if (exStyle and WS_EX_LAYERED = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);

  PNG := TPNGGraphic.Create;
  try

      Stream := TResourceStream.Create(HInstance, 'SPLASH', RT_RCDATA);
      try
          PNG.LoadFromStream(Stream);
    finally
        Stream.Free;
        end;

    PreMultiplyBitmap(PNG);

      ClientWidth := PNG.Width;
    ClientHeight := PNG.Height;

      BitmapPos := Point(0, 0);
    BitmapSize.cx := ClientWidth;
      BitmapSize.cy := ClientHeight;

      // Setup alpha blending parameters
    BlendFunction.BlendOp := AC_SRC_OVER;
      BlendFunction.BlendFlags := 0;
    BlendFunction.SourceConstantAlpha := 255;
      BlendFunction.AlphaFormat := AC_SRC_ALPHA;

    // ... and action!
      UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, PNG.Canvas.Handle,
      @BitmapPos, 0, @BlendFunction, ULW_ALPHA);

      Show;

  finally
    PNG.Free;
  end;
end;

procedure TSplash2.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;

end.