Ich teste gerade ein bißchen mit dem AlphaBlending. Diese Komponente soll nur ein Test sein.
Ich hab das Problem, dass er zwar blendet, aber nicht auf dem Hintergrund sondern auf einer weißen Fläche. Das hängt anscheinend mit dem verändern des Canvas in der Oberklasse zusammen. Ich will, dass die Prozedur "Paint" aus der Oberklasse nicht direkt auf den Canvas, sondern auf ein Bitmap zeichnet, damit ich nachher flackern vermeiden kann. Allerdings funktioniert das Ändern des Canvas nicht richtig.

zusammenfalten · markieren

Delphi-Quellcode:

unit TransparentTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics;

type
  TTransparentTest = class(TGraphicControl)
  private
    { Private declarations }
    FColor: TColor;
    FAlphaValue: Byte;
    procedure SetColor(const Value: TColor);
    procedure SetAlphaValue(const Value: Byte);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    { Published declarations }
    property Color : TColor read FColor write SetColor;
    property AlphaValue: Byte read FAlphaValue write SetAlphaValue;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Tests', [TTransparentTest]);
end;

{ TTransparentTest }

constructor TTransparentTest.Create(AOwner: TComponent);
begin
  inherited;
end;

procedure TTransparentTest.Paint;
type
  PCanvas = ^TCanvas;
var FarbBitmap: TBitmap;
    NextBitmap: TBitmap;
    LOldCanvas: TCanvas;
    LBlendFunc: TBlendFunction;
begin
  FarbBitmap := TBitmap.Create;
  FarbBitmap.Width := Width;
  FarbBitmap.Height := Height;
  FarbBitmap.Canvas.Brush.Color := FColor;
  FarbBitmap.Canvas.FillRect(FarbBitmap.Canvas.ClipRect);

  NextBitmap := TBitmap.Create;
  NextBitmap.Width := Width;
  NextBitmap.Height := Height;

  LBlendFunc.BlendOp := AC_SRC_OVER;
  LBlendFunc.BlendFlags := 0;
  LBlendFunc.SourceConstantAlpha := fAlphaValue;
  LBlendFunc.AlphaFormat := 0;

  LOldCanvas := Canvas;
  PCanvas(@Canvas)^ := NextBitmap.Canvas;
  inherited Paint;
  PCanvas(@Canvas)^ := LOldCanvas;

  windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, FarbBitmap.Canvas.Handle,
                     0, 0, Width, Height, LBlendFunc);

  BitBlt(Canvas.Handle,0,0,Width,Height,NextBitmap.Canvas.Handle,0,0,SRCCOPY);

  FarbBitmap.Free;
  NextBitmap.Free;
end;

procedure TTransparentTest.SetAlphaValue(const Value: Byte);
begin
  FAlphaValue := Value;
  Invalidate;
end;

procedure TTransparentTest.SetColor(const Value: TColor);
begin
  FColor := Value;
  Invalidate;
end;

end.

erstmal ist dein fColor undefiniert (außer man ruft die SetColor auf), also einfach einen Startwert im Create dafür vergeben (für Alpha am besten auch gleich mit).

Und dann zu deinem eigentlichen Problem. Ich verstehe nicht warum du inherited Paint aufrufst und davor die Canvas umbiegst und danach wieder zurück.
Es reicht aus wenn du einfach mit AlphaBlend direkt auf die Originalcanvas das Blending ausführst. Denn das "inherited Paint" sorgt dafür das deine gesammte Canvas eingefärbt wird und somit blendest du anschließend dein FarbBitmap mit einer bereits komplett eingefärbten Grundfläsche.

Also folgende Zeilen entfernen:

markieren

Delphi-Quellcode:

 LOldCanvas := Canvas;
  PCanvas(@Canvas)^ := NextBitmap.Canvas;
  inherited Paint;
  PCanvas(@Canvas)^ := LOldCanvas;
[...]
BitBlt(Canvas.Handle,0,0,Width,Height,NextBitmap.Canvas.Handle,0,0,SRCCOPY);

Dann sollte anschließend auch FarbBitmap mit dem Hintergrund der Komponenten geblendet sein.

(wenn du nur den Hintergrund der Komponente mit einer Farbe blenden willst muss FarbBitmap auch nicht genau so groß sein wie deine Komponente (reicht 1pixel * 1pixel und dann kann die Funktion Alphablend dafür sorgend das die Farbfläche auf volle größe gestretcht wird)

Inherited Paint ohne alles würde aber auf den Canvas der Komponente zeichnen. Da ich aber nachher noch auf den Canvas blenden muss, würde ich zwei Zeichenoperationen auf dem Canvas in einem Aufruf von "Paint" haben. Genau das will ich verhindern, damit ich auch schon das Flackern in der Komponente selbst ein bißchen eindämmen kann.

das inherited Paint kann ganz weg. Wenn du mehrere Dinge blenden willst und erst beim letzten Schritt alles auf die richtige Canvas bringen willst dann ändere bei Alphablend den ersten Parameter und gibt dort statt der richtigen Canvas dein NewPic an.

markieren

Delphi-Quellcode:

//erstes Blending auf das Tempbild
windows.AlphaBlend(NeuesBild.Canvas.Handle, 0, 0, Width, Height, FarbBitmap.Canvas.Handle,
                     0, 0, Width, Height, LBlendFunc);
//zweites Blending auf die richtige Canvas
windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, NeuesBild.Canvas.Handle,
                     0, 0, Width, Height, LBlendFunc);

Dadurch das du zur Zeit hinter dem Alphablend noch BitBlt hast übermalst du mit BitBlt das geblendete. Du malst also im ersten Schritt mit AlphaBlend deine geblendete Farbe und danach übermalst du die geblendete Canvas wieder mit NextBitmap (durch BitBlt)

zusammenfalten · markieren

Delphi-Quellcode:

unit BildLabel;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics, Forms, StdCtrls;
  
type
  TBildLabel = class(TGraphicControl)
  private
    FPicture: TBitmap;
    FAlphaValue: Byte;
    procedure SetPicture(const Value: TBitmap);
    procedure SetAlphaValue(const Value: Byte);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property Picture: TBitmap read FPicture write SetPicture;
    property AlphaValue: Byte read FAlphaValue write SetAlphaValue;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('My Own', [TBildLabel]);
end;

{ TBildLabel }

constructor TBildLabel.Create(AOwner: TComponent);
begin
  inherited;
  FPicture := TBitmap.Create;
  fAlphaValue := 0;
end;

destructor TBildLabel.Destroy;
begin
  FPicture.Free;
  inherited;
end;

procedure TBildLabel.Paint;
var Bitmap: TBitmap;
    BlendFunction: TBlendFunction;
begin
  //Buffer-Bitmap erstellen
  Bitmap := TBitmap.Create;
  Bitmap.Width := Width;
  Bitmap.Height := Height;
  //Picture in Buffer-Bitmap kopieren
  Bitmap.Canvas.StretchDraw(Bitmap.Canvas.ClipRect,FPicture);

  //Buffer-Bitmap in den Canvas laden
  BlendFunction.BlendOp := AC_SRC_OVER;
  BlendFunction.BlendFlags := 0;
  BlendFunction.SourceConstantAlpha := fAlphaValue;
  BlendFunction.AlphaFormat := 0;

  windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, Bitmap.Canvas.Handle,
                     0, 0, Width, Height, BlendFunction);

  Bitmap.Free;
end;

procedure TBildLabel.SetAlphaValue(const Value: Byte);
begin
  if FAlphaValue <> Value then begin
    FAlphaValue := Value;
    Invalidate;
  end;
end;

procedure TBildLabel.SetPicture(const Value: TBitmap);
begin
  if FPicture <> Value then begin
    FPicture.Assign(Value);
    Invalidate;
  end;
end;

end.

Die Komponente ist diesmal eine andere, ich hab aber folgendes Problem:

Zur Designzeit ist alles perfekt, zur Laufzeit aber blendet er nicht richtig. Heißt er blendet immer auf einen weißen Hintergrund, anstatt auf den Hintergrund der sich hinter ihm befindet !!??

Bei der anderen Komponente (s.o) hab ich es jetzt hinbekommen, aber halt bei dieser nicht.

hast du schonmal versucht ob zur Laufzeit "SetPicture" jemals aufgerufen wird? (was jedoch nicht erklärt warum zur Laufzeit das Bild farblos bleibt). Oder hast du zur Laufzeit mal geprüft welche größe fPicture hat?

das Problem ist ja nicht FPIcture. Sondern der Hintergrund auf dem geblendet wird. Der ist zur Laufzeit immer weiß. anstatt dem Hintergrund, der sich "Unter/hinter" der Komponente befindet.

*Insblauerat* versuch es mal mit TCustomControl als Basisklasse.

An dem quelltext ist so weit ich sehe alles richtig. Hast du eventuell noch eine andere Unit mit dem gleichen namen wo du noch einen Fehler drin hast (eventuell hast du die Unit mit "speichern unter" an einen anderen Platz befördert). Ich hab der Vermutung das die Unit die zur Designzeit verwendet wird eine andere ist als die welche zur Laufzeit eingebunden wird. Am besten du suchst mal und löschst eine eventuelle vorhandene kopie weg, sowie vorhandene dcu's

@Khabarakh: TCustomControl ist hier der völlig falsche weg da dann die Alphatransparenz nicht funktioniert. TCustomControl hat ein Handle und TGraphicControl nicht womit sich TGraphicControl dank Delphiinternas auf den Parent zeichnet und somit eine Alphatransparenz möglich macht.