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.