Исчезать в альфа-смешанной форме PNG в Delphi - PullRequest
4 голосов
/ 04 августа 2009

Я задавал вопрос по этому поводу несколько лет назад, когда Vista была впервые выпущена, но так и не решил проблему и отложил ее, чтобы рассмотреть ее позже.

У меня есть заставка, на которую я приложил огромные усилия, чтобы выглядеть великолепно. Это 32-битный альфа-формат PNG. У меня есть некоторый код (который я могу выкопать, если требуется!), Который отлично работает под Windows XP или под Vista +, когда композиция на рабочем столе выключена. Тем не менее, под Vista + все прозрачные части черного цвета, уничтожая все, что выглядит великолепно!

Итак, мой вопрос заключается в следующем: как кто-либо мог отображать PNG с 32-битной альфа-связью в виде заставки таким образом, чтобы он работал как с включенной композицией рабочего стола, так и без нее ? Я не против использования сторонних компонентов, если это необходимо, бесплатно или иным образом.

В идеале это будет работать в Delphi 7.

Обновление: кроме ответов ниже, которые работают очень хорошо, я обнаружил, что компонент TMS TAdvSmoothSplashScreen также отлично справляется с этой задачей, хотя и несколько сложнее.

Ответы [ 2 ]

6 голосов
/ 04 августа 2009

Тим, я только что попробовал это на Vista / D2007 с выбранной темой «Windows Classic»:

Альфа-Смешанный Заставка в Delphi - Часть 2 http://melander.dk/articles/alphasplash2/2/

нет черного фона, который я мог видеть ... он все еще выглядит великолепно.

5 голосов
/ 04 августа 2009

Статья, на которую ссылается Боб С, дает правильный ответ. Поскольку эта статья содержит немного дополнительной информации, которая вам действительно нужна, вот форма / единица, которую я создаю через нее (обратите внимание, что вам понадобится библиотека GraphicEx отсюда :

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