Fórum Sair no estilo do Windows XP #240986

procedure DoMorphBMP( Imagem1, Imagem2: TBitmap   ; Destino: TCanvas; X,Y: Integer; Rate: Integer; var CancelVar: Boolean);
var
   bmpResult: TBitmap;
   i: Integer;
begin
   bmpResult := TBitmap.Create;
   imagem1.PixelFormat := pf24bit;
   imagem2.PixelFormat := pf24bit;
   bmpResult.Assign( Imagem1 );
   FCancelMorph := False;

   i := 0;
   while {not fCancelMorph and} (i <= Rate) do
   begin
      Blendit(Imagem1.Scanline[(Imagem1.Height-1)],Imagem2.Scanline[(Imagem2.Height-1)],bmpResult.Scanline[(BmpResult.Height-1)],Imagem1.Width,Imagem1.Height,(i*$20 Div Rate));
      Destino.Draw(X, Y, bmpResult);
      Inc(i);
   end;

   FCancelMorph := False;
   
   bmpResult.Free;
end;

procedure Blendit(bFr,bTo,bLn : Pointer ; Width,Height : Integer ; Dens : LongInt); assembler;
Const
  Mask0101 = $00FF00FF;
  Mask1010 = $FF00FF00;
ASM
  MOV &EBX, EBX
  MOV &EDI, EDI
  MOV &ESI, ESI
  MOV &ESP, ESP
  MOV &EBP, EBP

  MOV EBX, Dens
  MOV Dens1, EBX

  NEG BL
  ADD BL, $20
  MOV Dens2, EBX
  CMP Dens1, 0
  JZ  @Final
  MOV EDI, bFr
  MOV ESI, bTo
  MOV ECX, bLn

  MOV EAX, Width
  lea EAX, [EAX+EAX*2+3]
  AND EAX, $FFFFFFFC
  IMUL Height
  ADD EAX, EDI
  MOV FinA, EAX

  MOV EBP,EDI
  MOV ESP,ESI
  MOV ECX,ECX

@LOOPA:
  MOV  EAX, [EBP]
  MOV  EDI, [ESP]
  MOV  EBX, EAX
  AND  EAX, Mask1010
  AND  EBX, Mask0101
  SHR  EAX, 5
  IMUL EAX, Dens2
  IMUL EBX, Dens2
  MOV  ESI, EDI
  AND  EDI, Mask1010
  AND  ESI, Mask0101
  SHR  EDI, 5
  IMUL EDI, Dens1
  IMUL ESI, Dens1
  ADD  EAX, EDI
  ADD  EBX, ESI
  AND  EAX, Mask1010
  SHR  EBX, 5
  AND  EBX, Mask0101
  OR   EAX, EBX
  MOV [ECX], EAX

  ADD  EBP, 4
  ADD  ESP, 4
  ADD  ECX, 4

  CMP  EBP, FinA
  JNE  @LOOPA

@FINAL:

  MOV EBX, &EBX
  MOV EDI, &EDI
  MOV ESI, &ESI
  MOV ESP, &ESP
  MOV EBP, &EBP
End;