Label unabhänig von der form "alpha blenden"

[SirThornberry]

So, hab mal schnell sowas nachgebaut (hab bewusst nicht den alten Beitrag editiert weil sonst niemand mitbekommt das etwas entscheidentes dazu gekommen ist)

So wirds verwendet:
- Den Source als "uAlphaLabel.pas" abspeichern.
- Wie gewohnt einfach normale Labels auf dem Form plazieren
- In die Uses des Forms wo die Labels drauf sind "uAlphaLabel" aufnehmen, dabei darauf achten das in den uses "uAlphaLabel" hinter "StdCtrls" steht.
- dadurch wird jetzt jedes Label welches sich auf dem Form befindet zu einem "alphalabel", dementsprechend können wir auch im Constructor den Alphawert setzen (Label1.Alphaval := 127)

Standard Alphawert des Alphalabels ist 255 damit nicht Labels die eigentlich keine Transparenz haben sollen plözlich transparent sind.

Natürlich kann man auch einfach die Klasse umbenennen und als eigene Komponente registrieren.

Delphi-Quellcode:

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.