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;