alpha key - transparency

[SirThornberry]

here is a solution how to make Controls derived from TCustomControl AlphaTransparent.

You have to override the Paint-Methode and there you have to get the parent-picture. This picture you have to blend with the inherited-Paint picture. And then you simply have to paint this blended picture to the real Canvas.

Here is an example for TPanel (unit uAlphaTransPanel):

Delphi-Quellcode:

unit uAlphaTransPanel;

interface

uses
  windows, graphics, classes, ExtCtrls, messages;

type
  TPanel = class(ExtCtrls.TPanel)
  protected
    procedure Paint; override;
  private
    fAlphaVal : Byte;
    fBmpParent: TBitmap;
    fBmpOwn   : TBitmap;
    procedure FSetAlphaVal(AValue: Byte);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AlphaBlendValue: Byte read fAlphaVal write FSetAlphaVal default 255;
  end;

implementation

constructor TPanel.Create(AOwner: TComponent);
begin
  fAlphaVal  := 255;
  fBmpParent := TBitmap.Create;
  fBmpOwn    := TBitmap.Create;
  inherited Create(AOwner);
end;

destructor TPanel.Destroy;
begin
  inherited Destroy;
  fBmpOwn.Free;
  fBmpParent.Free;
end;

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

procedure TPanel.Paint;
var LOldCanvas: TCanvas;
    LBlendFunc: TBlendFunction;
begin
  if (fAlphaVal < 255) and HandleAllocated and Assigned(Parent) then
  begin
    fBmpOwn.Width  := Width;
    fBmpOwn.Height := Height;
    LOldCanvas := Canvas;
    PPointer(@Canvas)^ := fBmpOwn.Canvas;
    inherited Paint;
    PPointer(@Canvas)^ := LOldCanvas;

    fBmpParent.Width  := Parent.Width;
    fBmpParent.Height := Parent.Height;
    Parent.Perform(WM_ERASEBKGND, fBmpParent.Canvas.Handle, 0);
    Parent.Perform(WM_PAINT, fBmpParent.Canvas.Handle, 0);

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

    AlphaBlend(fBmpOwn.Canvas.Handle, 0, 0, Width, Height,
               fBmpParent.Canvas.Handle, Left, Top, Width, Height, LBlendFunc);

    BitBlt(Canvas.Handle, 0, 0, Width, Height, fBmpOwn.Canvas.Handle, 0, 0, SRCCOPY);
  end else
    inherited;
end;

end.

Now you have to write this unit at the last position in your "uses" (must be behind the original-unit).

Zitat:

[...]
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, uAlphaTransPanel;
[...]

Now TPanel supports alphatransparenz. Simply write:
Panel1.AlphaBlendValue := 127; and your Panel is transparent (50%)

If the Background under the Panel will be changed the panel ist not notified and so the panel shows the old picture. In this case you have manually update the Panel (Call Panel.Invalidate)