transparentes bild über form legen und hin und her blenden

[SirThornberry]

So hier das was ich im Edit geschrieben hab. Ich mach mal einen eigenen Beitrag draus damit es nicht untergeht.
So bringt man TImage die Alphatransparenz bei:
In die Unit wo das TImage die Transparenz beherrschen soll (standardmäßig unit1) muss folgendes mit rein

Delphi-Quellcode:

type
  TGraphicControl = class(Controls.TGraphicControl);
  TImage = class(ExtCtrls.TImage)
  private
    fAlphaVal: Byte;
    procedure FSetAlphaVal(AValue: Byte);
  public
    constructor Create(AOwner: TComponent); override;

    property AlphaVal: Byte read fAlphaVal write FSetAlphaVal;
    procedure Paint; override;
  end;
[...]
constructor TImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fAlphaVal := 255;
end;

procedure TImage.Paint;
type
  PControlStyle = ^TControlStyle;
  PCanvas = ^TCanvas;
var LBitmap: TBitmap;
    LOldCanvas: TCanvas;
    LBlendFunc: TBlendFunction;
begin
  if fAlphaVal = 255 then
    inherited Paint
  else if fAlphaVal > 0 then
  begin
    LBitmap := TBitmap.Create;
    LBitmap.Width := Width;
    LBitmap.Height := Height;

    if csOpaque in ControlStyle then
      ControlStyle := ControlStyle - [csOpaque];

    LOldCanvas := TGraphicControl(Self).Canvas;
    PCanvas(@TGraphicControl(Self).Canvas)^ := LBitmap.Canvas;

    //aktullen Hintergrund Holen
    BitBlt(LBitmap.Canvas.Handle, 0, 0, Width, Height, LOldCanvas.Handle, 0, 0, SRCCOPY);
    inherited Paint;

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

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

    PCanvas(@TGraphicControl(Self).Canvas)^ := LOldCanvas;

    if csOpaque in ControlStyle then
      ControlStyle := ControlStyle - [csOpaque];
    LBitmap.Free;
  end;
end;

procedure TImage.FSetAlphaVal(AValue: Byte);
begin
  if AValue <> fAlphaVal then
  begin
    fAlphaVal := AValue;
    Repaint;
  end;
end;

Alternativ kann man diese Klasse auch in eine eigene Unit packen und diese Unit hinter/nach der Unit ExtCtrls in die Uses aufnehmen.