AlphaBlending und Canvas der Oberklasse

[Merlin1988]

Ich teste gerade ein bißchen mit dem AlphaBlending. Diese Komponente soll nur ein Test sein.
Ich hab das Problem, dass er zwar blendet, aber nicht auf dem Hintergrund sondern auf einer weißen Fläche. Das hängt anscheinend mit dem verändern des Canvas in der Oberklasse zusammen. Ich will, dass die Prozedur "Paint" aus der Oberklasse nicht direkt auf den Canvas, sondern auf ein Bitmap zeichnet, damit ich nachher flackern vermeiden kann. Allerdings funktioniert das Ändern des Canvas nicht richtig.

Delphi-Quellcode:

unit TransparentTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics;

type
  TTransparentTest = class(TGraphicControl)
  private
    { Private declarations }
    FColor: TColor;
    FAlphaValue: Byte;
    procedure SetColor(const Value: TColor);
    procedure SetAlphaValue(const Value: Byte);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    { Published declarations }
    property Color : TColor read FColor write SetColor;
    property AlphaValue: Byte read FAlphaValue write SetAlphaValue;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Tests', [TTransparentTest]);
end;

{ TTransparentTest }

constructor TTransparentTest.Create(AOwner: TComponent);
begin
  inherited;
end;

procedure TTransparentTest.Paint;
type
  PCanvas = ^TCanvas;
var FarbBitmap: TBitmap;
    NextBitmap: TBitmap;
    LOldCanvas: TCanvas;
    LBlendFunc: TBlendFunction;
begin
  FarbBitmap := TBitmap.Create;
  FarbBitmap.Width := Width;
  FarbBitmap.Height := Height;
  FarbBitmap.Canvas.Brush.Color := FColor;
  FarbBitmap.Canvas.FillRect(FarbBitmap.Canvas.ClipRect);

  NextBitmap := TBitmap.Create;
  NextBitmap.Width := Width;
  NextBitmap.Height := Height;

  LBlendFunc.BlendOp := AC_SRC_OVER;
  LBlendFunc.BlendFlags := 0;
  LBlendFunc.SourceConstantAlpha := fAlphaValue;
  LBlendFunc.AlphaFormat := 0;

  LOldCanvas := Canvas;
  PCanvas(@Canvas)^ := NextBitmap.Canvas;
  inherited Paint;
  PCanvas(@Canvas)^ := LOldCanvas;

  windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, FarbBitmap.Canvas.Handle,
                     0, 0, Width, Height, LBlendFunc);

  BitBlt(Canvas.Handle,0,0,Width,Height,NextBitmap.Canvas.Handle,0,0,SRCCOPY);

  FarbBitmap.Free;
  NextBitmap.Free;
end;

procedure TTransparentTest.SetAlphaValue(const Value: Byte);
begin
  FAlphaValue := Value;
  Invalidate;
end;

procedure TTransparentTest.SetColor(const Value: TColor);
begin
  FColor := Value;
  Invalidate;
end;

end.