// Auf eine Email-Anfrage, ob man ein TLabel vor einem TImage
// langsam ausblenden könne, entstand der folgende Code:


// Getestet mit D2010 unter Win7

type 
  TForm1 = class(TForm) 
    Image1: TImage; 
    Label1: TLabel; 
    SpeedButton1: TSpeedButton; 
    procedure FormShow(Sender: TObject); 
    procedure SpeedButton1Click(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure Vorbereitung(SR, IG: TImage; BM: TBitmap; LB: TLabel); 
    procedure Ausblenden(SRC: TImage; LBL: TLabel; Pause: Byte); 
    procedure DoIt(Image: TImage; HLP: TBitmap; Pause: Byte); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
procedure TForm1.FormShow(Sender: TObject); 
begin 
  Label1.Transparent := True; // War bei mir leider nötig, warum? 
end; 
 
procedure TForm1.DoIt(Image: TImage; HLP: TBitmap; Pause: Byte); 
var 
  PBA, PBB: PByteArray; 
  X, Y, B3, Step: Integer; 
 function rech(P, F: Integer): Byte; 
 asm 
  cmp eax, edx 
  je @raus 
  jl @plus 
  sub eax, 4 
  cmp eax, edx 
  jge @raus 
  jmp @gleich 
 @plus: 
  add eax, 4 
  cmp eax, edx 
  jle @raus 
 @gleich: 
  mov eax, edx 
 @raus: 
 end; 
  begin 
    B3 := Image.Picture.Bitmap.Width * 3; 
    Step := 0; 
    repeat 
      for Y := 0 to Image.Picture.Bitmap.Height - 1 do 
      begin 
        PBA := Image.Picture.Bitmap.ScanLine[Y]; 
        PBB := HLP.ScanLine[Y]; 
        X := 0; 
        while X < B3 do 
        begin 
          PBA[X] := rech(PBA[X], PBB[X]); 
          PBA[X + 1] := rech(PBA[X + 1], PBB[X + 1]); 
          PBA[X + 2] := rech(PBA[X + 2], PBB[X + 2]); 
          inc(X, 3); 
        end; 
      end; 
      sleep(Pause); 
      Image.refresh; 
      inc(Step, 4); 
    until Step > 255; 
  end; 
 
  procedure TForm1.Vorbereitung(SR, IG: TImage; BM: TBitmap; LB: TLabel); 
  var 
    RCT: TRect; 
  begin 
    with LB do 
    begin 
      IG.Picture.Bitmap.PixelFormat := pf24Bit; 
      IG.Picture.Bitmap.Width := Width; 
      IG.Picture.Bitmap.Height := Height; 
      BM.PixelFormat := pf24Bit; 
      BM.Width := IG.Width; 
      BM.Height := IG.Height; 
      IG.Canvas.CopyRect(IG.Canvas.ClipRect, Form1.Canvas, BoundsRect); 
      IG.Left := Left; 
      IG.Top := Top; 
      RCT := rect(Left - SR.Left, Top - SR.Top, Left - SR.Left + BM.Width, 
        Top - SR.Top + BM.Height); 
    end; 
    BM.Canvas.CopyRect(BM.Canvas.ClipRect, SR.Canvas, RCT); 
  end; 
 
  procedure TForm1.Ausblenden(SRC: TImage; LBL: TLabel; Pause: Byte); 
  var 
    Img: TImage; 
    Bmp: TBitmap; 
  begin 
    Img := TImage.Create(Self); 
    Img.AutoSize := True; 
    Img.Visible := False; 
    Img.Parent := Self; 
    Bmp := TBitmap.Create; 
    Vorbereitung(SRC, Img, Bmp, LBL); 
    Img.Visible := True; 
    DoIt(Img, Bmp, Pause); 
    LBL.Visible := False; 
    FreeAndNil(Bmp); 
    FreeAndNil(Img); 
  end; 

// Beispielaufruf 
  procedure TForm1.SpeedButton1Click(Sender: TObject); 
  begin 
    if Label1.Visible then 
    begin 
      SpeedButton1.Enabled := False; 
      Ausblenden(Image1, Label1, 44); 
      SpeedButton1.Caption := 'Anzeigen'; 
      SpeedButton1.Enabled := True; 
    end 
    else 
    begin 
      Label1.Visible := True; 
      SpeedButton1.Caption := 'Ausblenden'; 
    end; 
  end;

 


 

Zugriffe seit 6.9.2001 auf Delphi-Ecke