TPaintBox rotate image with SetWorldTransform

Question

I'm loading an image into a TPaintBox, then try to rotate it with SetWorldTransform as suggested in this answer:

The picture loads fine via the TPaintBox.Invalidate -> TPaintBox.OnPaint.
But when I click the test button BtnRotateWorldTransform, I see the image flicker but no rotation.

procedure TFrmRotateImage.FormCreate(Sender: TObject);
begin
  FWICImage := TWICImage.Create; 
end;

procedure TFrmRotateImage.BtnLoadPaintBoxClick(Sender: TObject);
begin
   if DlgOpen.Execute then  // PNG or JPG file
   begin
      try
         FWICImage.LoadFromFile(DlgOpen.FileName);
         FBoxLoaded := true;
         PaintBox.Invalidate;
      finally
      end;
   end;
end;

procedure TFrmRotateImage.PaintBoxPaint(Sender: TObject);  // OnPaint handler
begin
   if not FBoxLoaded then Exit;
   PaintBox.Canvas.Draw(0,0,FWICImage);
end;

procedure TFrmRotateImage.BtnRotateWorldTransformClick(Sender: TObject);  // Test button
var
   lRect: TRect;
begin
   lRect.Top    := PaintBox.Top;
   lRect.Left   := PaintBox.Left;
   lRect.Width  := PaintBox.Width;
   lRect.Height := PaintBox.Height;
   StretchDrawRotated(PaintBox.Canvas,lRect,90,lRect.CenterPoint,FWICImage);
   PaintBox.Invalidate;
end;

with

procedure XForm_SetRotation(out AXForm: TXForm; AAngle: Extended; ACenter: TPoint);
var
  SinA, CosA: Extended;
begin
  SinCos(AAngle, SinA, CosA);
  AXForm.eM11 := CosA;
  AXForm.eM12 := SinA;
  AXForm.eM21 := -SinA;
  AXForm.eM22 := CosA;
  AXForm.eDx := (ACenter.X - (CosA * ACenter.X)) + ((SinA * ACenter.Y));
  AXForm.eDy := (ACenter.Y - (SinA * ACenter.X)) - ((CosA * ACenter.Y));
end;

procedure StretchDrawRotated(ACanvas: TCanvas; const ARect: TRect; AAngle: Extended; ACenter: TPoint; AGraphic: TGraphic);
var
  XForm, XFormOld: TXForm;
  GMode: Integer;
begin
  GMode := SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
  try
    if GetWorldTransform(ACanvas.Handle, XFormOld) then
      try
        XForm_SetRotation(XForm, AAngle, ACenter);
        SetWorldTransform(ACanvas.Handle, XForm);
        ACanvas.StretchDraw(ARect, AGraphic);
      finally
        SetWorldTransform(ACanvas.Handle, XFormOld);
      end;
  finally
    SetGraphicsMode(ACanvas.Handle, GMode);
  end;
end;

What am I forgetting?

Answer 1

I wrote a complete example. In this example, I show how to rotate, translate, scale an image and combine those transformations.

For the purpose, I wrote 3 functions to prepare the rotation, scaling and translation easily.

In the PaintBox1Paint event handler, I take fixed values for the rotation, scaling and translation. Of course, in a normal application this comes from elsewhere (UI for example). Transformation computation should be outside of the PaintBox1Paint procedure and done each time the parameters varies. Then Invalidate should be called so that it is repainted with the new computed transformation.

procedure TForm4.FormCreate(Sender: TObject);
begin
    FWICImage := TWICImage.Create;
end;

procedure TForm4.FormDestroy(Sender: TObject);
begin
    FreeAndNil(FWICImage);
end;

procedure TForm4.LoadImageButtonClick(Sender: TObject);
begin
    FWICImage.LoadFromFile('C:\Users\fpiette\Pictures\Delphi25 ICS.jpg');
    FBoxLoaded := TRUE;
    PaintBox1.Invalidate;
end;

function XForm_SetRotation(
    AAngle     : Single;
    ACenter    : TPoint) : TXForm;
var
    SinA, CosA: Extended;
begin
    SinCos(AAngle, SinA, CosA);
    Result.eM11 := CosA;
    Result.eM12 := SinA;
    Result.eM21 := -SinA;
    Result.eM22 := CosA;
    Result.eDx := (ACenter.X - (CosA * ACenter.X)) + ((SinA * ACenter.Y));
    Result.eDy := (ACenter.Y - (SinA * ACenter.X)) - ((CosA * ACenter.Y));
end;

function XForm_SetScale(
    const AZoomX : Single;
    const AZoomY : Single;
    const center: TPoint) : TXForm;
begin
    Result.eM11 := AZoomX;
    Result.eM12 := 0.0;
    Result.eM21 := 0.0;
    Result.eM22 := AZoomY;
    Result.eDx  := center.x - AZoomX * center.x;
    Result.eDy  := center.y - AZoomY * center.y;
end;

function XForm_SetTranslate(
    const ADistX : Integer;
    const ADistY : Integer) : TXForm;
begin
    Result.eM11 := 1.0;
    Result.eM12 := 0.0;
    Result.eM21 := 0.0;
    Result.eM22 := 1.0;
    Result.eDx  := ADistX;
    Result.eDy  := ADistY;
end;

procedure TForm4.PaintBox1Paint(Sender: TObject);
var
    XFormScale  : TXForm;
    XFormRot    : TXForm;
    XFormXLat   : TXForm;
    XForm       : TXForm;
    XFormOld    : TXForm;
    GMode       : Integer;
    AZoomFactor : Single;
    AAngle      : Single;
    ADistX      : Integer;
    ADistY      : Integer;
    ACanvas     : TCanvas;
begin
    if not FBoxLoaded then
        Exit;

    AZoomFactor := 0.25;
    AAngle      := 30.0;
    ADistX      := 100;
    ADistY      := 200;
    ACanvas     := PaintBox1.Canvas;

    GMode := SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
    try
        if GetWorldTransform(ACanvas.Handle, XFormOld) then begin
            try
                XFormRot   := XForm_SetRotation(
                                  AAngle,
                                  Point(FWICImage.Width div 2,
                                        FWICImage.Height div 2));
                XFormScale := XForm_SetScale(
                                  AZoomFactor, AZoomFactor, Point(0, 0));
                XFormXLat  := XForm_SetTranslate(ADistX, ADistY);
                CombineTransform(XForm, XFormRot, XFormScale);
                CombineTransform(XForm, XForm,    XFormXLat);
                SetWorldTransform(ACanvas.Handle, XForm);
                ACanvas.Draw(0, 0, FWICImage);
            finally
                SetWorldTransform(ACanvas.Handle, XFormOld);
            end;
        end;
    finally
        SetGraphicsMode(ACanvas.Handle, GMode);
    end;
end;