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

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;

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...