Bitmap Zoom In & Out Smooth

Dies ist ein Beispiel, ein Bitmap jeder Größe ruckelfrei in einen Zoom zu bewegen.

Es werden benötigt : 1xLabel, 1xTrackBar

uses ComCtrls, ExtCtrls, StdCtrls

var
  bmp : TBitmap;
  
//

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp := TBitmap.Create;
  bmp.Assign(Image1.Picture.Bitmap);
  bmp.PixelFormat := pf32bit;

  TrackBar1.Min := 10;
  TrackBar1.Max := 200;
  TrackBar1.Frequency := 10;
  TrackBar1.PageSize := 10;
  TrackBar1.Position := 100;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  Zoom, x, y: Integer;
begin
  Zoom := TrackBar1.Position;
  if not (Visible or (Zoom = 100)) or (Zoom = 0) then
    Exit;

  SetMapMode(image1.Canvas.Handle, MM_ISOTROPIC);
  SetWindowExtEx(image1.Canvas.Handle, 100, 100, nil);
  SetViewportExtEx(image1.Canvas.Handle, Zoom, Zoom, nil);
  x := image1.Width * 50 div Zoom - bmp.Width div 2;
  y := image1.Height * 50 div Zoom - bmp.Height div 2;
  image1.Canvas.Draw(x, y, bmp);
  if (x > 0) or (y > 0) then begin
    image1.Canvas.Brush.Color := clWhite;
    ExcludeClipRect(image1.Canvas.Handle, x, y, x + bmp.Width, y + bmp.Height);
    image1.Canvas.FillRect(image1.Canvas.ClipRect);
  end;

  Label1.Caption := 'Zoom: ' + IntToStr(TrackBar1.Position) + '%';
end;