transparentes bild über form legen und hin und her blenden

[n0b0dy]

naja dann hab ich eben keine ahung

[TeronG]

Zitat von n0b0dy:

entweder ich lass das sein oder mach eine gifanimation da draus

wenn du die schneller schaffst ...

[n0b0dy]

vllt net schneller, aber einfacher *g*

jedenfalls bin ich heute zufaul was neues zu lernen *g*

[Khabarakh]

Zitat von n0b0dy:

naja dann hab ich eben keine ahung

Deswegen musst du jetzt dieses Projekt machen, dann hast du nächstes Mal etwas mehr Ahnung von Scanline, ABGR und Co. .

[add] Nagut, lassen wirs *g* [/add]

[n0b0dy]

jo find ich auch *g*
und wenn cih doch mal bock habe, komm ich auf dich zurück

[SirThornberry]

ach Leute, benutzt doch mal die Forensuche und verweist nicht immer nur auf die GR32. Windows hat doch alles was man dazu braucht dabei. In der Unit Windows ist die Funktion Alphablend definiert mit der man Bilder blenden kann.
@Threadsteller: Soll das bild über dem gesammten form liegen oder nur an einer bestimmten Stelle? Wenn du die Info preisgibst ist das ganze nur ne Sache von 2 bis 3 Minuten

[n0b0dy]

hey cool. endlcih einer, ders einfach macht *g* und ohne dieses GR32 (und ohne gif *g*)

also das bild is genau in der mitte von der form undzwar 200x200px

[SirThornberry]

so hier mal der Quelltext meiner kleine Klasse die dafür da ist (man sollte bei sowas doublebuffered des Form auf True setzen)

Delphi-Quellcode:

  TFadeImage = class(TGraphicControl)
  private
    fAlphaVal: Byte;
    fBitmap: TGraphic;
    procedure FOnBitmapChanged(Sender: TObject);
    procedure FSetAlphaVal(AValue: Byte);
    procedure FSetBitmap(ABitmap: TGraphic);
  public
    property AlphaVal: Byte read fAlphaVal write FSetAlphaVal;
    property Graphic: TGraphic read fBitmap write FSetBitmap;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  end;
[...]
procedure TFadeImage.FOnBitmapChanged(Sender: TObject);
begin
  Repaint;
end;

procedure TFadeImage.FSetAlphaVal(AValue: Byte);
begin
  if AValue <> fAlphaVal then
  begin
    fAlphaVal := AValue;
    if Assigned(Parent) and Parent.HandleAllocated then
      Repaint;
  end;
end;

procedure TFadeImage.FSetBitmap(ABitmap: TGraphic);
begin
  if ABitmap <> fBitmap then
  begin
    if ABitmap = nil then
      FreeAndNil(fBitmap)
    else begin
      if fBitmap = nil then
        fBitmap := TBitmap.Create;
      fBitmap.Assign(ABitmap);
      fBitmap.OnChange := FOnBitmapChanged;
    end;
    Repaint;
  end;
end;

constructor TFadeImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fAlphaVal := 255;
end;

destructor TFadeImage.Destroy;
begin
  inherited Destroy;
  if Assigned(fBitmap) then
    fBitmap.Free;
end;

procedure TFadeImage.Paint;
var LBlendFunc: TBlendFunction;
begin
  if (fAlphaVal <> 0) and Assigned(fBitmap) then
  begin
    SetStretchBltMode(Canvas.Handle, STRETCH_HALFTONE);
    SetBrushOrgEx(Canvas.Handle, 0, 0, nil);
    LBlendFunc.BlendOp := AC_SRC_OVER;
    LBlendFunc.BlendFlags := 0;
    LBlendFunc.SourceConstantAlpha := fAlphaVal;
    LBlendFunc.AlphaFormat := 0;
    windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height, TBitmap(fBitmap).Canvas.Handle,
                       0, 0, fBitmap.Width, fBitmap.Height, LBlendFunc);
  end;
end;

Wenn das ganze nicht mit dem Untergrund, sondern mit einer festen farbe blenden soll dann kann das ganze auch so aussehen und doublebuffered ist nicht notwendig. Die Farbe mit der geblendet werden soll wird über das Property "Color" festgelegt.

Delphi-Quellcode:

  TFadeImage = class(TGraphicControl)
  private
    fAlphaVal: Byte;
    fBitmap: TGraphic;
    procedure FOnBitmapChanged(Sender: TObject);
    procedure FSetAlphaVal(AValue: Byte);
    procedure FSetBitmap(ABitmap: TGraphic);
  public
    property AlphaVal: Byte read fAlphaVal write FSetAlphaVal;
    property Color;
    property Graphic: TGraphic read fBitmap write FSetBitmap;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  end;

[...]

procedure TFadeImage.FOnBitmapChanged(Sender: TObject);
begin
  Paint;
end;

procedure TFadeImage.FSetAlphaVal(AValue: Byte);
begin
  if AValue <> fAlphaVal then
  begin
    fAlphaVal := AValue;
    if Assigned(Parent) and Parent.HandleAllocated then
      Paint;
  end;
end;

procedure TFadeImage.FSetBitmap(ABitmap: TGraphic);
begin
  if ABitmap <> fBitmap then
  begin
    if ABitmap = nil then
      FreeAndNil(fBitmap)
    else begin
      if fBitmap = nil then
        fBitmap := TBitmap.Create;
      fBitmap.Assign(ABitmap);
      fBitmap.OnChange := FOnBitmapChanged;
    end;
    Repaint;
  end;
end;

constructor TFadeImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fAlphaVal := 255;
end;

destructor TFadeImage.Destroy;
begin
  inherited Destroy;
  if Assigned(fBitmap) then
    fBitmap.Free;
end;

procedure TFadeImage.Paint;
var LBlendFunc: TBlendFunction;
    LBitmap: TBitmap;
begin
  if (fAlphaVal <> 0) and Assigned(fBitmap) then
  begin
    LBitmap := TBitmap.Create;
    LBitmap.Width := Width;
    LBitmap.Height := Height;

    SetStretchBltMode(Canvas.Handle, STRETCH_HALFTONE);
    SetBrushOrgEx(Canvas.Handle, 0, 0, nil);
    LBlendFunc.BlendOp := AC_SRC_OVER;
    LBlendFunc.BlendFlags := 0;
    LBlendFunc.SourceConstantAlpha := fAlphaVal;
    LBlendFunc.AlphaFormat := 0;
    LBitmap.Canvas.Brush.Color := Color;
    LBitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
    windows.AlphaBlend(LBitmap.Canvas.Handle, 0, 0, Width, Height, TBitmap(fBitmap).Canvas.Handle,
                       0, 0, fBitmap.Width, fBitmap.Height, LBlendFunc);
    BitBlt(Canvas.Handle, 0, 0, Width, Height, LBitmap.Canvas.Handle, 0, 0, SRCCOPY);
    LBitmap.Free;
  end;
end;

[Edit]
So, habs nun nach Anfangsschwierigkeiten es auch hinbekommen das ganze auf ein TImage anzuwenden. Also einfach wie gewohnt TImages aufs Form schmeißen, bissl quelltext (den ich dann gleich nachreiche) schreiben und schon kann TImage auch Alphatransparenz.

[SirThornberry]

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.

[n0b0dy]

cool. hab hier die letzte methode probiert.

es funktioniert zwar, aber leider fadet der nicht so schön, als wenn man den alphavalue wert von einem formular ändert....
und flackern tuts auch ein wenig.
DoubleBuffered := True hab ich im FormCreate gemacht.