Плавная смена изображений с поддержкой альфа канала

procedure Morphing(Bm1,Bm2: TBitmap); 
var 
   i: integer; 
   x, y: integer; 
   bm: TBitMap; 
   p1, p2, p: PByteArray; 
   c: integer; 
   k: integer; 
begin 
   bm := TBitMap.Create; 
 
if bm1.Height < bm2.Height then 
   begin 
     bm.Height := bm1.Height; 
     bm2.Height := bm1.Height; 
   end 
   else 
   begin 
     bm.Height := bm2.Height; 
     bm1.Height := bm2.Height; 
   end; 
   if bm1.Width < bm2.Width then 
   begin 
     bm.Width := bm1.Width; 
     bm2.Width := bm1.Width; 
   end 
   else 
   begin 
     bm.Width := bm2.Width; 
     bm1.Width := bm2.Width; 
   end; 
 
   bm.PixelFormat := pf24bit; 
   bm1.PixelFormat := pf24bit; 
   bm2.PixelFormat := pf24bit; 
 
   Canvas.Draw(0,0,Bm1); 
   SetBkMode(Canvas.Handle,TRANSPARENT); 
   Canvas.TextOut((Width div 2) - (Canvas.TextWidth(FText) div 2),(Height div 2) - (Canvas.TextHeight(FText) div 2),FText); 
   SetBkMode(Canvas.Handle,OPAQUE); 
   for i := 1 to FInterval - 1 do 
   begin 
     for y := 0 to bm.Height - 1 do 
     begin 
       p := bm.ScanLine[y]; 
       p1 := bm1.ScanLine[y]; 
       p2 := bm2.ScanLine[y]; 
       for x := 0 to bm.Width * 3 - 1 do 
         p^[x] := round((p1^[x] * (FInterval - i) + p2^[x] * i) / FInterval); 
     end; 
     Canvas.Draw(0,0,Bm); 
     SetBkMode(Canvas.Handle,TRANSPARENT); 
 
    Canvas.TextOut((Width div 2) - (Canvas.TextWidth(FText) div 2),(Height div 2) - (Canvas.TextHeight(FText) div 2),FText); 
    SetBkMode(Canvas.Handle,OPAQUE); 
    Application.ProcessMessages; 
    if Application.Terminated then 
      break; 
   end; 
   Canvas.Draw(0,0,Bm2); 
   SetBkMode(Canvas.Handle,TRANSPARENT); 
   Canvas.TextOut((Width div 2) - (Canvas.TextWidth(FText) div 2),(Height div 2) - (Canvas.TextHeight(FText) div 2),FText); 
   SetBkMode(Canvas.Handle,OPAQUE); 
   bm.Destroy; 
end;