Плавно превратить один рисунок в другой

Previous  Top  Next

    
 

 

 

Code:

procedure TForm1.Button1Click(Sender: TObject);

const

count = 100;

var

i: integer;

x, y: integer;

bm, bm1, bm2: TBitMap;

p1, p2, p: PByteArray;

c: integer;

k: integer;

begin

bm := TBitMap.Create;

bm1 := TBitMap.Create;

bm2 := TBitMap.Create;

bm1.LoadFromFile('Bitmap1.bmp');

bm2.LoadFromFile('Bitmap2.bmp');

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;

 

Form1.Canvas.Draw(0, 0, bm1);

for i := 1 to count - 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] * (count - i) + p2^[x] * i) / count);

   end;

   Form1.Canvas.Draw(0, 0, bm);

   Form1.Caption := IntToStr(round(i / count * 100)) + '%';

   Application.ProcessMessages;

   if Application.Terminated then

     break;

end;

Form1.Canvas.Draw(0, 0, bm2);

Form1.Caption := 'done';

bm1.Destroy; bm2.Destroy; bm.Destroy;

end;

 

©Drkb::03896