ProjectiveTransform

procedure ProjectiveTransform(img: TImage32; const dstCorners: TArrayOfPointD);


Projective image transformations preserves lines (within images), but not parallelism.

The new geometry is defined by 4 coordinates representing a convex quadrilateral.


  uses Image32, Image32_PNG, 
    Image32_Vector, Image32_Transform;
  ...
var
  img: TImage32;
  dst: TArrayOfPointD;
begin
  img := TImage32.Create;
  img.LoadFromFile('clouds.png');
  
  //setup the transformation geometry
  dst := Rectangle(src.Bounds); 
  dst[0].Y := 20;
  dst[3].Y := img.Height-20; 
  
  //transform and save
  ProjectiveTransform(img, dst);
  img.SaveToFile('clouds_proj.png');
  img.Free;
end;
      


  uses Image32, Image32_Vectors, 
    Image32_Extra, Image32_Layers, 
    Image32_Transform, ImagePanels;
  
  
  var {global}
    buttonMovingLayer: TLayer32;
    layeredImage: TLayeredImage32;
  
  procedure TForm1.FormCreate(Sender: TObject);
  var
    i: integer;
    layer: TLayer32;
    path: TArrayOfPointD;
    rec: TRect;
  begin

    layeredImage := TLayeredImage32.Create(400,400);
    layeredImage.BackgroundColor := $FFF8F8F8;
    
    layer := layeredImage.AddNewLayer('master - hidden');
    layer.Visible := false;
    layer.Image.LoadFromResource('BEETLE' , 'BMP');

    layer := layeredImage.AddNewLayer('working copy - hidden');
    layer.Visible := false;
    layer.Image.Assign(layeredImage[0].Image);

    layer := layeredImage.AddNewLayer('final - visible');
    layer.Image.Assign(layeredImage[0].Image);
    layer.PositionCenteredAt(layeredImage.ClientMidPoint);

    //add extra 4 layers for 4 control buttons positioned at
    //the 4 corners of the layer's (layeredImage[2]) image
    rec := layer.Bounds;
    path := Rectangle(rec); //lt, rt, rb & lb
    for i := 0 to high(path) do
      with layeredImage.AddNewLayer('button') do
      begin
        SetSize(12,12);
        DrawButton(Image, ClientMidPoint, 10);
        PositionCenteredAt(path[i]);
      end;
  end;

  procedure TForm1.Panel1MouseDown(Sender: TObject; 
    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  var
    pt: TPoint;
  begin
    pt := Point(X,Y);
    //nb: using ImagePanels
    if not Panel1.ClientToBitmap(pt) then Exit;
    buttonMovingLayer := layeredImage.GetLayerAt(pt);
    if Assigned(buttonMovingLayer) and 
      (buttonMovingLayer.Name <> 'button') then
        buttonMovingLayer := nil;
  end;

  procedure TForm1.Panel1MouseMove(Sender: TObject; 
    Shift: TShiftState; X, Y: Integer);
  var
    i: integer;
    pt: TPoint;
    dstPath: TArrayOfPointD;
    workingImg: TImage32;
  begin
    pt := Point(X,Y);
    if not Assigned(buttonMovingLayer) or
      not Panel1.ClientToBitmap(pt) then Exit;
    //position the moving button at the new point
    buttonMovingLayer.PositionCenteredAt(pt);
    
    workingImg := layeredImage[1].Image;
    //start with a fresh image for working layer
    workingImg.Assign(layeredImage[0].Image);

    //get the 4 button coordinates
    SetLength(dstPath, 4);
    for i := 0 to 3 do
      dstPath[i] := layeredImage[i+3].MidPoint;

    if ProjectiveTransform(workingImg, dstPath) then
    begin
      //only update 'final' layeredImage[2].Image
      //when the transformation is successful.
      //The function will be unsuccessful if dstPath, 
      //(ie the 4 buttons) don't form a convex polygon.

      layeredImage[2].Image.Assign(workingImg);
      //and reposition layeredImage[2]
      rec := GetBounds(dstPath);      
      layeredImage[2].PositionAt(rec.TopLeft);
    end;
    Display(layeredImage.MergedImage);    
  end;
      


See Also

Image32_Layers