Thema: Delphi Image mit Alphawert

Einzelnen Beitrag anzeigen

Phiennes

Registriert seit: 30. Nov 2008
Ort: Bochum
30 Beiträge
 
#1

Image mit Alphawert

  Alt 25. Mai 2009, 02:44
Hi,

Ich versuche diesen Code auf ein Image anzuwenden. Leider klappt das nicht ganz, weil der Compiler mir an den markierten Stellen sagt: "Variable erforderlich".

Hat jemand eine Idee wo das Problem liegt?

Delphi-Quellcode:
unit uAlphaImage;

interface

uses
  windows, graphics, classes, ExtCtrls;

type
  TImage = class(ExtCtrls.TImage)
  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 TImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Transparent := True;
  fAlphaVal := 255;
end;

procedure TImage.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; // Variable erforderlich
    inherited Paint;
    PCanvas(@Canvas)^ := LOldCanvas; // Variable erforderlich


    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 TImage.FSetAlphaVal(AAlpha: Byte);
begin
  if AAlpha <> fAlphaVal then
  begin
    fAlphaVal := AAlpha;
    Repaint;
  end;
end;

end.
Vielen Dank schonmal im Vorraus.

lG Phiennes
  Mit Zitat antworten Zitat