unit uAlphaLabel;

interface

uses
  windows, graphics, classes, StdCtrls;

type
  TLabel = class(StdCtrls.TLabel)
  private
    fAlphaVal: Byte;
    procedure FSetAlphaVal(AAlpha: Byte);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    property AlphaVal: Byte read fAlphaVal write FSetAlphaVal default 255;
  end;

implementation

constructor TLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Transparent := True;
  fAlphaVal := 255;
end;

procedure TLabel.Paint;
type
  PCanvas = ^TCanvas;
var LBitmap: TBitmap;
    LOldCanvas: TCanvas;
    LBlendFunc: TBlendFunction;
begin
  if fAlphaVal = 255 then
    inherited Paint
  else begin
    LBitmap := TBitmap.Create;
    LBitmap.Width := Width;
    LBitmap.Height := Height;
    BitBlt(LBitmap.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
    LOldCanvas := Canvas;
    PCanvas(@Canvas)^ := LBitmap.Canvas;
    inherited Paint;
    PCanvas(@Canvas)^ := LOldCanvas;
    LBlendFunc.BlendOp := AC_SRC_OVER;
    LBlendFunc.BlendFlags := 0;
    LBlendFunc.SourceConstantAlpha := fAlphaVal;
    LBlendFunc.AlphaFormat := 0;
    windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, LBitmap.Canvas.Handle,
                       0, 0, Width, Height, LBlendFunc);
    LBitmap.Free;
  end;
end;

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

end.