Rotate bitmap by real angle

by

tl;dr; Use GDI+

SetWorldTransform

With WinAPI’s SetWorldTransform you can transform the space of device context: rotate, shear, offset, and scale. This is done by setting the members of a transform matrix of type XFORM. Fill its members according the documentation.

procedure RotateBitmap(Bmp: TBitmap; Rads: Single; AdjustSize: Boolean;
  BkColor: TColor = clNone);
var
  C: Single;
  S: Single;
  XForm: tagXFORM;
  Tmp: TBitmap;
begin
  C := Cos(Rads);
  S := Sin(Rads);
  XForm.eM11 := C;
  XForm.eM12 := S;
  XForm.eM21 := -S;
  XForm.eM22 := C;
  Tmp := TBitmap.Create;
  try
    Tmp.TransparentColor := Bmp.TransparentColor;
    Tmp.TransparentMode := Bmp.TransparentMode;
    Tmp.Transparent := Bmp.Transparent;
    Tmp.Canvas.Brush.Color := BkColor;
    if AdjustSize then
    begin
      Tmp.Width := Round(Bmp.Width * Abs(C) + Bmp.Height * Abs(S));
      Tmp.Height := Round(Bmp.Width * Abs(S) + Bmp.Height * Abs(C));
      XForm.eDx := (Tmp.Width - Bmp.Width * C + Bmp.Height * S) / 2;
      XForm.eDy := (Tmp.Height - Bmp.Width * S - Bmp.Height * C) / 2;
    end
    else
    begin
      Tmp.Width := Bmp.Width;
      Tmp.Height := Bmp.Height;
      XForm.eDx := (Bmp.Width - Bmp.Width * C + Bmp.Height * S) / 2;
      XForm.eDy := (Bmp.Height - Bmp.Width * S - Bmp.Height * C) / 2;
    end;
    SetGraphicsMode(Tmp.Canvas.Handle, GM_ADVANCED);
    SetWorldTransform(Tmp.Canvas.Handle, XForm);
    BitBlt(Tmp.Canvas.Handle, 0, 0, Tmp.Width, Tmp.Height, Bmp.Canvas.Handle,
      0, 0, SRCCOPY);
    Bmp.Assign(Tmp);
  finally
    Tmp.Free;
  end;
end;

PlgBlt

The PlgBlt function performs a bit-block transfer from the specified rectangle in the source device context to the specified parallelogram in the destination device context. Map the corner points of the source image via the lpPoint parameter.

procedure RotateBitmap(Bmp: TBitmap; Rads: Single; AdjustSize: Boolean;
  BkColor: TColor = clNone);
var
  C: Single;
  S: Single;
  Tmp: TBitmap;
  OffsetX: Single;
  OffsetY: Single;
  Points: array[0..2] of TPoint;
begin
  C := Cos(Rads);
  S := Sin(Rads);
  Tmp := TBitmap.Create;
  try
    Tmp.TransparentColor := Bmp.TransparentColor;
    Tmp.TransparentMode := Bmp.TransparentMode;
    Tmp.Transparent := Bmp.Transparent;
    Tmp.Canvas.Brush.Color := BkColor;
    if AdjustSize then
    begin
      Tmp.Width := Round(Bmp.Width * Abs(C) + Bmp.Height * Abs(S));
      Tmp.Height := Round(Bmp.Width * Abs(S) + Bmp.Height * Abs(C));
      OffsetX := (Tmp.Width - Bmp.Width * C + Bmp.Height * S) / 2;
      OffsetY := (Tmp.Height - Bmp.Width * S - Bmp.Height * C) / 2;
    end
    else
    begin
      Tmp.Width := Bmp.Width;
      Tmp.Height := Bmp.Height;
      OffsetX := (Bmp.Width - Bmp.Width * C + Bmp.Height * S) / 2;
      OffsetY := (Bmp.Height - Bmp.Width * S - Bmp.Height * C) / 2;
    end;
    Points[0].X := Round(OffsetX);
    Points[0].Y := Round(OffsetY);
    Points[1].X := Round(OffsetX + Bmp.Width * C);
    Points[1].Y := Round(OffsetY + Bmp.Width * S);
    Points[2].X := Round(OffsetX - Bmp.Height * S);
    Points[2].Y := Round(OffsetY + Bmp.Height * C);
    PlgBlt(Tmp.Canvas.Handle, Points, Bmp.Canvas.Handle, 0, 0, Bmp.Width,
      Bmp.Height, 0, 0, 0);
    Bmp.Assign(Tmp);
  finally
    Tmp.Free;
  end;
end;

Graphics32

Graphics32 is a library especially designed for fast bitmap handling. It requires some experience to grasp its full potential, but the documentation as well as the provided examples should get you started.

A rotation of a TBitmap32 image is done by transforming it by one of the many available transformation classes. The TAffineTransformation class is needed here. First, shift the image half its size to the upper left, then rotate, and shift the result back to the lower right, possibly using the new image dimensions.

uses
  GR32, GR32_Transforms;

procedure RotateBitmap(Bmp: TBitmap32; Degs: Integer; AdjustSize: Boolean;
  BkColor: TColor = clNone; Transparent: Boolean = False); overload;
var
  Tmp: TBitmap32;
  Transformation: TAffineTransformation;
begin
  Tmp := TBitmap32.Create;
  Transformation := TAffineTransformation.Create;
  try
    Transformation.BeginUpdate;
    Transformation.SrcRect := FloatRect(0, 0, Bmp.Width, Bmp.Height);
    Transformation.Translate(-0.5 * Bmp.Width, -0.5 * Bmp.Height);
    Transformation.Rotate(0, 0, -Degs);
    if AdjustSize then
      with Transformation.GetTransformedBounds do
        Tmp.SetSize(Round(Right - Left), Round(Bottom - Top))
    else
      Tmp.SetSize(Bmp.Width, Bmp.Height);
    Transformation.Translate(0.5 * Tmp.Width, 0.5 * Tmp.Height);
    Transformation.EndUpdate;
    Tmp.Clear(Color32(BkColor));
    if not Transparent then
      Bmp.DrawMode := dmTransparent;
    Transform(Tmp, Bmp, Transformation);
    Bmp.Assign(Tmp);
    Bmp.OuterColor := Color32(BkColor);
    if Transparent then
      Bmp.DrawMode := dmTransparent;
  finally
    Transformation.Free;
    Tmp.Free;
  end;
end;

procedure RotateBitmap(Bmp: TBitmap; Degs: Integer; AdjustSize: Boolean;
  BkColor: TColor = clNone); overload;
var
  Tmp: TBitmap32;
  Transparent: Boolean;
begin
  Tmp := TBitmap32.Create;
  try
    Transparent := Bmp.Transparent;
    Tmp.Assign(Bmp);
    RotateBitmapGR32(Tmp, Degs, AdjustSize, BkColor, Transparent);
    Bmp.Assign(Tmp);
    if Transparent then
      Bmp.Transparent := True;
  finally
    Tmp.Free;
  end;
end;

GDI+

Introduced in Windows XP, Microsoft’s GDI+ API is more efficient then the default GDI API. For Delphi 2009 and up, the library is available from here. For older Delphi versions, the library is available from here.

In GDI+ the rotation is also done by a transformation matrix. Drawing works quite differently though. Create a TGPGraphics object and attach it to a device context with its constructor. Subsequently, drawing operations on the object are translated by the API and will be output to the destination context.

uses
  GDIPOBJ, GDIPAPI; // < D2009
  GdiPlus;          // >= D2009

procedure RotateBitmap(Bmp: TBitmap; Degs: Integer; AdjustSize: Boolean;
  BkColor: TColor = clNone);
var
  Tmp: TGPBitmap;
  Matrix: TGPMatrix;
  C: Single;
  S: Single;
  NewSize: TSize;
  Graphs: TGPGraphics;
  P: TGPPointF;
begin
  Tmp := TGPBitmap.Create(Bmp.Handle, Bmp.Palette);
  Matrix := TGPMatrix.Create;
  try
    Matrix.RotateAt(Degs, MakePoint(0.5 * Bmp.Width, 0.5 * Bmp.Height));
    if AdjustSize then
    begin
      C := Cos(DegToRad(Degs));
      S := Sin(DegToRad(Degs));
      NewSize.cx := Round(Bmp.Width * Abs(C) + Bmp.Height * Abs(S));
      NewSize.cy := Round(Bmp.Width * Abs(S) + Bmp.Height * Abs(C));
      Bmp.Width := NewSize.cx;
      Bmp.Height := NewSize.cy;
    end;
    Graphs := TGPGraphics.Create(Bmp.Canvas.Handle);
    try
      Graphs.Clear(ColorRefToARGB(ColorToRGB(BkColor)));
      Graphs.SetTransform(Matrix);
      Graphs.DrawImage(Tmp, (Cardinal(Bmp.Width) - Tmp.GetWidth) div 2,
        (Cardinal(Bmp.Height) - Tmp.GetHeight) div 2);
    finally
      Graphs.Free;
    end;
  finally
    Matrix.Free;
    Tmp.Free;
  end;
end;

Handling transparency

The routines above preserve the transparent settings of the fead bitmap, with the exception of the Graphics32 solution which requires an additional Transparent parameter.

Performance and image quality

I wrote a test application (see full code below) to tune the performance of the various methods and to compare the resulting image quality.

The first and most important conclusion is that GDI+ uses anti-aliasing where the others do not, resulting in the best image quality. (I unsuccessfully tried to prevent anti-aliasing by setting CompositingQuality, InterpolationMode, SmoothingMode, and PixelOffsetMode, so when anti-aliasing is not preferred, do not use GDI+.)

Furthermore, the GDI+ solution is also the fastest method, by far.

Test results

unit RotateTestForm;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,
  JPEG, Math, GR32, GR32_Transforms, GDIPOBJ, GDIPAPI {, GdiPlus};

type
  TTestForm = class(TForm)
  private
    FImage: TImage;
    FOpenDialog: TOpenDialog;
    procedure FormPaint(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  TestForm: TTestForm;

implementation

{$R *.dfm}

procedure RotateBitmapSWT(Bmp: TBitmap; Rads: Single; AdjustSize: Boolean;
  BkColor: TColor = clNone);
var
  C: Single;
  S: Single;
  XForm: TXForm;
  Tmp: TBitmap;
begin
  C := Cos(Rads);
  S := Sin(Rads);
  XForm.eM11 := C;
  XForm.eM12 := S;
  XForm.eM21 := -S;
  XForm.eM22 := C;
  Tmp := TBitmap.Create;
  try
    Tmp.TransparentColor := Bmp.TransparentColor;
    Tmp.TransparentMode := Bmp.TransparentMode;
    Tmp.Transparent := Bmp.Transparent;
    Tmp.Canvas.Brush.Color := BkColor;
    if AdjustSize then
    begin
      Tmp.Width := Round(Bmp.Width * Abs(C) + Bmp.Height * Abs(S));
      Tmp.Height := Round(Bmp.Width * Abs(S) + Bmp.Height * Abs(C));
      XForm.eDx := (Tmp.Width - Bmp.Width * C + Bmp.Height * S) / 2;
      XForm.eDy := (Tmp.Height - Bmp.Width * S - Bmp.Height * C) / 2;
    end
    else
    begin
      Tmp.Width := Bmp.Width;
      Tmp.Height := Bmp.Height;
      XForm.eDx := (Bmp.Width - Bmp.Width * C + Bmp.Height * S) / 2;
      XForm.eDy := (Bmp.Height - Bmp.Width * S - Bmp.Height * C) / 2;
    end;
    SetGraphicsMode(Tmp.Canvas.Handle, GM_ADVANCED);
    SetWorldTransform(Tmp.Canvas.Handle, XForm);
    BitBlt(Tmp.Canvas.Handle, 0, 0, Tmp.Width, Tmp.Height, Bmp.Canvas.Handle,
      0, 0, SRCCOPY);
    Bmp.Assign(Tmp);
  finally
    Tmp.Free;
  end;
end;

procedure RotateBitmapPLG(Bmp: TBitmap; Rads: Single; AdjustSize: Boolean;
  BkColor: TColor = clNone);
var
  C: Single;
  S: Single;
  Tmp: TBitmap;
  OffsetX: Single;
  OffsetY: Single;
  Points: array[0..2] of TPoint;
begin
  C := Cos(Rads);
  S := Sin(Rads);
  Tmp := TBitmap.Create;
  try
    Tmp.TransparentColor := Bmp.TransparentColor;
    Tmp.TransparentMode := Bmp.TransparentMode;
    Tmp.Transparent := Bmp.Transparent;
    Tmp.Canvas.Brush.Color := BkColor;
    if AdjustSize then
    begin
      Tmp.Width := Round(Bmp.Width * Abs(C) + Bmp.Height * Abs(S));
      Tmp.Height := Round(Bmp.Width * Abs(S) + Bmp.Height * Abs(C));
      OffsetX := (Tmp.Width - Bmp.Width * C + Bmp.Height * S) / 2;
      OffsetY := (Tmp.Height - Bmp.Width * S - Bmp.Height * C) / 2;
    end
    else
    begin
      Tmp.Width := Bmp.Width;
      Tmp.Height := Bmp.Height;
      OffsetX := (Bmp.Width - Bmp.Width * C + Bmp.Height * S) / 2;
      OffsetY := (Bmp.Height - Bmp.Width * S - Bmp.Height * C) / 2;
    end;
    Points[0].X := Round(OffsetX);
    Points[0].Y := Round(OffsetY);
    Points[1].X := Round(OffsetX + Bmp.Width * C);
    Points[1].Y := Round(OffsetY + Bmp.Width * S);
    Points[2].X := Round(OffsetX - Bmp.Height * S);
    Points[2].Y := Round(OffsetY + Bmp.Height * C);
    PlgBlt(Tmp.Canvas.Handle, Points, Bmp.Canvas.Handle, 0, 0, Bmp.Width,
      Bmp.Height, 0, 0, 0);
    Bmp.Assign(Tmp);
  finally
    Tmp.Free;
  end;
end;

procedure RotateBitmapGR32(Bmp: TBitmap32; Degs: Integer; AdjustSize: Boolean;
  BkColor: TColor = clNone; Transparent: Boolean = False); overload;
var
  Tmp: TBitmap32;
  Transformation: TAffineTransformation;
begin
  Tmp := TBitmap32.Create;
  Transformation := TAffineTransformation.Create;
  try
    Transformation.BeginUpdate;
    Transformation.SrcRect := FloatRect(0, 0, Bmp.Width, Bmp.Height);
    Transformation.Translate(-0.5 * Bmp.Width, -0.5 * Bmp.Height);
    Transformation.Rotate(0, 0, -Degs);
    if AdjustSize then
      with Transformation.GetTransformedBounds do
        Tmp.SetSize(Round(Right - Left), Round(Bottom - Top))
    else
      Tmp.SetSize(Bmp.Width, Bmp.Height);
    Transformation.Translate(0.5 * Tmp.Width, 0.5 * Tmp.Height);
    Transformation.EndUpdate;
    Tmp.Clear(Color32(BkColor));
    if not Transparent then
      Bmp.DrawMode := dmTransparent;
    Transform(Tmp, Bmp, Transformation);
    Bmp.Assign(Tmp);
    Bmp.OuterColor := Color32(BkColor);
    if Transparent then
      Bmp.DrawMode := dmTransparent;
  finally
    Transformation.Free;
    Tmp.Free;
  end;
end;

procedure RotateBitmapGR32(Bmp: TBitmap; Degs: Integer; AdjustSize: Boolean;
  BkColor: TColor = clNone); overload;
var
  Tmp: TBitmap32;
  Transparent: Boolean;
begin
  Tmp := TBitmap32.Create;
  try
    Transparent := Bmp.Transparent;
    Tmp.Assign(Bmp);
    RotateBitmapGR32(Tmp, Degs, AdjustSize, BkColor, Transparent);
    Bmp.Assign(Tmp);
    if Transparent then
      Bmp.Transparent := True;
  finally
    Tmp.Free;
  end;
end;

procedure RotateBitmapGDIP(Bmp: TBitmap; Degs: Integer; AdjustSize: Boolean;
  BkColor: TColor = clNone);
var
  Tmp: TGPBitmap;
  Matrix: TGPMatrix;
  C: Single;
  S: Single;
  NewSize: TSize;
  Graphs: TGPGraphics;
  P: TGPPointF;
begin
  Tmp := TGPBitmap.Create(Bmp.Handle, Bmp.Palette);
  Matrix := TGPMatrix.Create;
  try
    Matrix.RotateAt(Degs, MakePoint(0.5 * Bmp.Width, 0.5 * Bmp.Height));
    if AdjustSize then
    begin
      C := Cos(DegToRad(Degs));
      S := Sin(DegToRad(Degs));
      NewSize.cx := Round(Bmp.Width * Abs(C) + Bmp.Height * Abs(S));
      NewSize.cy := Round(Bmp.Width * Abs(S) + Bmp.Height * Abs(C));
      Bmp.Width := NewSize.cx;
      Bmp.Height := NewSize.cy;
    end;
    Graphs := TGPGraphics.Create(Bmp.Canvas.Handle);
    try
      Graphs.Clear(ColorRefToARGB(ColorToRGB(BkColor)));
      Graphs.SetTransform(Matrix);
      Graphs.DrawImage(Tmp, (Cardinal(Bmp.Width) - Tmp.GetWidth) div 2,
        (Cardinal(Bmp.Height) - Tmp.GetHeight) div 2);
    finally
      Graphs.Free;
    end;
  finally
    Matrix.Free;
    Tmp.Free;
  end;
end;

{ TTestForm }

constructor TTestForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Font.Name := 'Tahoma';
  Top := 0;
  ClientWidth := 560;
  ClientHeight := 915;
  Show;
  FImage := TImage.Create(Self);
  FOpenDialog := TOpenDialog.Create(Self);
  FOpenDialog.Title := 'Select an small sized image (min. 100 x 100)';
  FOpenDialog.Options := FOpenDialog.Options + [ofFileMustExist];
  FOpenDialog.Filter := 'JPEG|*.JPG|BMP|*.BMP';
  if FOpenDialog.Execute then
  begin
    FImage.Picture.LoadFromFile(FOpenDialog.FileName);
    OnPaint := FormPaint;
    Invalidate;
  end
  else
    Application.Terminate;
end;

procedure TTestForm.FormPaint(Sender: TObject);
var
  Img: TBitmap;
  Bmp: TBitmap;
  Bmp32: TBitmap32;
  BkColor: TColor;
  AdjustSize: Boolean;
  Degs: Integer;
  Rads: Single;
  RotCount: Integer;
  I: Integer;
  Tick: Cardinal;
begin
  Img := TBitmap.Create;
  Bmp := TBitmap.Create;
  Bmp32 := TBitmap32.Create;
  try
    BkColor := clBtnFace;
    Img.Canvas.Brush.Color := BkColor;
    Img.Width := 100;
    Img.Height := 100;
    Img.Canvas.Draw(0, 0, FImage.Picture.Graphic);
    AdjustSize := False;
    Degs := 45;
    Rads := DegToRad(Degs);
    RotCount := 1000;

    Canvas.TextOut(10, 10, 'Original:');
    Canvas.Draw(10, 30, Img);
    Canvas.TextOut(10, 140, Format('Size = %d x %d', [Img.Width, Img.Height]));
    Canvas.TextOut(10, 160, Format('Angle = %d°', [Degs]));
    Canvas.TextOut(10, 250, Format('%d rotations:', [RotCount]));

    Canvas.TextOut(120, 10, 'SetWorldTransform:');
    Bmp.Assign(Img);
    RotateBitmapSWT(Bmp, Rads, AdjustSize, BkColor);
    Canvas.Draw(120, 30, Bmp);
    if not AdjustSize then
    begin
      Tick := GetTickCount;
      for I := 0 to RotCount - 2 do
        RotateBitmapSWT(Bmp, Rads, AdjustSize, BkColor);
      Canvas.TextOut(120, 250, Format('%d msec', [GetTickCount - Tick]));
      Canvas.Draw(120, 140, Bmp);
    end;

    Canvas.TextOut(230, 10, 'PlgBlt:');
    Bmp.Assign(Img);
    RotateBitmapPLG(Bmp, Rads, AdjustSize, BkColor);
    Canvas.Draw(230, 30, Bmp);
    if not AdjustSize then
    begin
      Tick := GetTickCount;
      for I := 0 to RotCount - 2 do
        RotateBitmapPLG(Bmp, Rads, AdjustSize, BkColor);
      Canvas.TextOut(230, 250, Format('%d msec', [GetTickCount - Tick]));
      Canvas.Draw(230, 140, Bmp);
    end;

    Canvas.TextOut(340, 10, 'Graphics32:');
    Bmp.Assign(Img);
    RotateBitmapGR32(Bmp, Degs, AdjustSize, BkColor);
    Canvas.Draw(340, 30, Bmp);
    if not AdjustSize then
    begin
      Tick := GetTickCount;
      for I := 0 to RotCount - 2 do
        RotateBitmapGR32(Bmp, Degs, AdjustSize, BkColor);
      Canvas.TextOut(340, 250, Format('%d msec', [GetTickCount - Tick]));
      Canvas.Draw(340, 140, Bmp);

      // Without in between conversion to TBitmap:
      Bmp32.Assign(Img);
      Tick := GetTickCount;
      for I := 0 to RotCount - 1 do
        RotateBitmapGR32(Bmp32, Degs, AdjustSize, BkColor, False);
      Canvas.TextOut(340, 270, Format('%d msec (optimized)',
        [GetTickCount - Tick]));
    end;

    Canvas.TextOut(450, 10, 'GDI+ :');
    Bmp.Assign(Img);
    RotateBitmapGDIP(Bmp, Degs, AdjustSize, BkColor);
    Canvas.Draw(450, 30, Bmp);
    if not AdjustSize then
    begin
      Tick := GetTickCount;
      for I := 0 to RotCount - 2 do
        RotateBitmapGDIP(Bmp, Degs, AdjustSize, BkColor);
      Canvas.TextOut(450, 250, Format('%d msec', [GetTickCount - Tick]));
      Canvas.Draw(450, 140, Bmp);
    end;
  finally
    Bmp32.Free;
    Bmp.Free;
    Img.Free;
    OnPaint := nil;
  end;
end;

end.

More Related Contents:

  1. How to efficiently rotate bitmaps in code
  2. Load Jpg/Gif/Bitmap and convert to Bitmap
  3. How to use ScanLine property for 24-bit bitmaps?
  4. Why should I not use “if Assigned()” before accessing objects?
  5. Why cannot take address to a nested local function in 64 bit Delphi?
  6. Debugging Access Violation errors?
  7. Which variables are initialized when in Delphi?
  8. System Error. Code: 8. Not enough storage is available to process this command
  9. Delphi 2010: How to save a whole record to a file?
  10. Registration-free COM/DLL?
  11. I do not understand what Application.ProcessMessages in Delphi is doing [closed]
  12. How do I let Delphi know I’ve already handled an exception?
  13. How to send a HTTP POST Request in Delphi using WinInet api
  14. Delphi Conversion Unicode Issues
  15. TThreadedQueue not capable of multiple consumers?
  16. How do I run a command-line program in Delphi?
  17. Should the compiler hint/warn when passing object instances directly as const interface parameters?
  18. Delphi – get what files are opened by an application
  19. How can I display Crystal XI reports inside a Delphi 2007 application?
  20. My program never releases the memory back. Why?
  21. Patch routine call in delphi
  22. Component Creation – Joining Components Together?
  23. Modifying or deleting a line from a text file the low-level way?
  24. DecimalSeparator in SysUtils and System.SysUtils
  25. why two aliases to “array of string” treated differently?
  26. Resize PNG image
  27. Delphi control that could mimic “Add-ons|Extension list” of Firefox?
  28. How can I make AllocateHwnd threadsafe?
  29. Can 48×48 or 64×64 icons be obtained from the Vista Shell?
  30. How to cast a Interface to a Object in Delphi

Leave a Comment