transparentes bild über form legen und hin und her blenden

[SirThornberry]

so hier mal der Quelltext meiner kleine Klasse die dafür da ist (man sollte bei sowas doublebuffered des Form auf True setzen)

Delphi-Quellcode:

  TFadeImage = class(TGraphicControl)
  private
    fAlphaVal: Byte;
    fBitmap: TGraphic;
    procedure FOnBitmapChanged(Sender: TObject);
    procedure FSetAlphaVal(AValue: Byte);
    procedure FSetBitmap(ABitmap: TGraphic);
  public
    property AlphaVal: Byte read fAlphaVal write FSetAlphaVal;
    property Graphic: TGraphic read fBitmap write FSetBitmap;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  end;
[...]
procedure TFadeImage.FOnBitmapChanged(Sender: TObject);
begin
  Repaint;
end;

procedure TFadeImage.FSetAlphaVal(AValue: Byte);
begin
  if AValue <> fAlphaVal then
  begin
    fAlphaVal := AValue;
    if Assigned(Parent) and Parent.HandleAllocated then
      Repaint;
  end;
end;

procedure TFadeImage.FSetBitmap(ABitmap: TGraphic);
begin
  if ABitmap <> fBitmap then
  begin
    if ABitmap = nil then
      FreeAndNil(fBitmap)
    else begin
      if fBitmap = nil then
        fBitmap := TBitmap.Create;
      fBitmap.Assign(ABitmap);
      fBitmap.OnChange := FOnBitmapChanged;
    end;
    Repaint;
  end;
end;

constructor TFadeImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fAlphaVal := 255;
end;

destructor TFadeImage.Destroy;
begin
  inherited Destroy;
  if Assigned(fBitmap) then
    fBitmap.Free;
end;

procedure TFadeImage.Paint;
var LBlendFunc: TBlendFunction;
begin
  if (fAlphaVal <> 0) and Assigned(fBitmap) then
  begin
    SetStretchBltMode(Canvas.Handle, STRETCH_HALFTONE);
    SetBrushOrgEx(Canvas.Handle, 0, 0, nil);
    LBlendFunc.BlendOp := AC_SRC_OVER;
    LBlendFunc.BlendFlags := 0;
    LBlendFunc.SourceConstantAlpha := fAlphaVal;
    LBlendFunc.AlphaFormat := 0;
    windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, TBitmap(fBitmap).Canvas.Handle,
                       0, 0, fBitmap.Width, fBitmap.Height, LBlendFunc);
  end;
end;

Wenn das ganze nicht mit dem Untergrund, sondern mit einer festen farbe blenden soll dann kann das ganze auch so aussehen und doublebuffered ist nicht notwendig. Die Farbe mit der geblendet werden soll wird über das Property "Color" festgelegt.

Delphi-Quellcode:

  TFadeImage = class(TGraphicControl)
  private
    fAlphaVal: Byte;
    fBitmap: TGraphic;
    procedure FOnBitmapChanged(Sender: TObject);
    procedure FSetAlphaVal(AValue: Byte);
    procedure FSetBitmap(ABitmap: TGraphic);
  public
    property AlphaVal: Byte read fAlphaVal write FSetAlphaVal;
    property Color;
    property Graphic: TGraphic read fBitmap write FSetBitmap;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  end;

[...]

procedure TFadeImage.FOnBitmapChanged(Sender: TObject);
begin
  Paint;
end;

procedure TFadeImage.FSetAlphaVal(AValue: Byte);
begin
  if AValue <> fAlphaVal then
  begin
    fAlphaVal := AValue;
    if Assigned(Parent) and Parent.HandleAllocated then
      Paint;
  end;
end;

procedure TFadeImage.FSetBitmap(ABitmap: TGraphic);
begin
  if ABitmap <> fBitmap then
  begin
    if ABitmap = nil then
      FreeAndNil(fBitmap)
    else begin
      if fBitmap = nil then
        fBitmap := TBitmap.Create;
      fBitmap.Assign(ABitmap);
      fBitmap.OnChange := FOnBitmapChanged;
    end;
    Repaint;
  end;
end;

constructor TFadeImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fAlphaVal := 255;
end;

destructor TFadeImage.Destroy;
begin
  inherited Destroy;
  if Assigned(fBitmap) then
    fBitmap.Free;
end;

procedure TFadeImage.Paint;
var LBlendFunc: TBlendFunction;
    LBitmap: TBitmap;
begin
  if (fAlphaVal <> 0) and Assigned(fBitmap) then
  begin
    LBitmap := TBitmap.Create;
    LBitmap.Width := Width;
    LBitmap.Height := Height;

    SetStretchBltMode(Canvas.Handle, STRETCH_HALFTONE);
    SetBrushOrgEx(Canvas.Handle, 0, 0, nil);
    LBlendFunc.BlendOp := AC_SRC_OVER;
    LBlendFunc.BlendFlags := 0;
    LBlendFunc.SourceConstantAlpha := fAlphaVal;
    LBlendFunc.AlphaFormat := 0;
    LBitmap.Canvas.Brush.Color := Color;
    LBitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
    windows.AlphaBlend(LBitmap.Canvas.Handle, 0, 0, Width, Height, TBitmap(fBitmap).Canvas.Handle,
                       0, 0, fBitmap.Width, fBitmap.Height, LBlendFunc);
    BitBlt(Canvas.Handle, 0, 0, Width, Height, LBitmap.Canvas.Handle, 0, 0, SRCCOPY);
    LBitmap.Free;
  end;
end;

[Edit]
So, habs nun nach Anfangsschwierigkeiten es auch hinbekommen das ganze auf ein TImage anzuwenden. Also einfach wie gewohnt TImages aufs Form schmeißen, bissl quelltext (den ich dann gleich nachreiche) schreiben und schon kann TImage auch Alphatransparenz.